Merge e2ad6e3e92 into release/next-js

This commit is contained in:
janeway-bot 2021-02-12 04:11:14 +04:00 committed by GitHub
commit e5f6d2a7c0
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
263 changed files with 10593 additions and 5812 deletions

View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1
oid sha256:a546edc83f0a2523d44ce79a2bdaa7497ace9a8c83985212cb1b6912182f8fa7
size 9129912
oid sha256:197e7c205c783e80008434a1975d8f1e86e1bd8c5d6ab2ca9273cf4749529b08
size 9218537

View File

@ -278,7 +278,7 @@
=/ app-rid=resource
(path-to-resource path)
=/ group-rid=resource
(fall (group-from-app-resource:met %graph app-rid) [nobody %bad-group])
(fall (peek-group:met %graph app-rid) [nobody %bad-group])
=/ group=(unit group)
(scry-group:grp group-rid)
:- (add-graph app-rid mailbox)

View File

@ -1,569 +1,27 @@
:: contact-hook [landscape]
:: contact-hook [landscape]: deprecated
::
::
/- *contact-hook,
*contact-view,
inv=invite-store,
*metadata-hook,
*metadata-store,
*group
/+ *contact-json,
default-agent,
dbug,
group-store,
verb,
resource,
grpl=group,
*migrate
~% %contact-hook-top ..part ~
/+ default-agent
|%
+$ card card:agent:gall
::
+$ versioned-state
$% state-zero
state-one
state-two
state-three
==
::
+$ state-zero [%0 state-base]
+$ state-one [%1 state-base]
+$ state-two [%2 state-base]
+$ state-three [%3 state-base]
+$ state-base
$: =synced
invite-created=_|
==
--
=| state-three
=* state -
%- agent:dbug
%+ verb |
::
^- 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 /groups]
==
++ on-save !>(state)
++ on-load
|= old-vase=vase
^- (quip card _this)
=/ old !<(versioned-state old-vase)
=| cards=(list card)
|^
|- ^- (quip card _this)
?: ?=(%3 -.old)
[cards this(state old)]
?: ?=(%2 -.old)
%_ $
old [%3 +.old]
::
cards
%+ welp
cards
%- zing
%+ turn
~(tap by synced.old)
|= [=path =ship]
^- (list card)
?. =(ship our.bol)
~
?> ?=([%ship *] path)
:~ (pass-store contacts+t.path %leave ~)
(pass-store contacts+path %watch contacts+path)
==
==
?: ?=(%1 -.old)
%_ $
-.old %2
::
synced.old
%- malt
%+ turn
~(tap by synced.old)
|= [=path =ship]
[ship+path ship]
::
cards
^- (list card)
;: welp
:~ [%pass /group %agent [our.bol %group-store] %leave ~]
[%pass /group %agent [our.bol %group-store] %watch /groups]
==
kick-old-subs
cards
==
==
%_ $
-.old %1
::
cards
:_ cards
[%pass /group %agent [our.bol %group-store] %watch /updates]
==
++ kick-old-subs
=/ paths
%+ turn
~(val by sup.bol)
|=([=ship =path] path)
?~ paths ~
[%give %kick paths ~]~
::
++ pass-store
|= [=wire =task:agent:gall]
^- card
[%pass wire %agent [our.bol %contact-store] task]
--
::
++ 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))
::
%import
?> (team:title our.bol src.bol)
(poke-import:cc q.vase)
==
[cards this]
::
++ on-watch
|= =path
^- (quip card _this)
?+ path (on-watch:def path)
[%contacts *] [(watch-contacts:cc t.path) this]
[%synced *] [(watch-synced: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 !<(update:group-store q.cage.sign))
[cards this]
::
%invite-update [~ this]
==
==
::
++ on-leave on-leave:def
++ on-peek
|= =path
^- (unit (unit cage))
?+ path (on-peek:def path)
[%x %export ~]
``noun+!>(state)
==
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card _this)
?. ?=([%try-rejoin @ @ *] wire)
(on-arvo:def wire sign-arvo)
=/ nack-count=@ud (slav %ud i.t.wire)
=/ who=@p (slav %p i.t.t.wire)
=/ pax t.t.t.wire
?> ?=([%behn %wake *] sign-arvo)
~? ?=(^ error.sign-arvo)
"behn errored in backoff timers, continuing anyway"
:_ this
[(try-rejoin:cc who pax +(nack-count))]~
::
++ on-fail on-fail:def
--
::
|_ bol=bowl:gall
++ grp ~(. grpl bol)
+* this .
def ~(. (default-agent this %|) bol)
::
++ poke-json
|= jon=json
^- (quip card _state)
(poke-contact-action (json-to-action jon))
++ on-init on-init:def
++ on-poke on-poke:def
++ on-watch on-watch:def
++ on-agent on-agent:def
++ on-arvo on-arvo:def
++ on-save !>(~)
++ on-load
|= old-vase=vase
^- (quip card _this)
[~ this]
::
++ 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)
?. |(=(path /~/default) (~(has by synced) path)) ~
=/ 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 members.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]
[%give %fact [/synced]~ %contact-hook-update !>([%initial synced])]
==
::
%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]
[%give %fact [/synced]~ %contact-hook-update !>([%initial synced])]
==
::
%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]] ~]~
[%give %fact [/synced]~ %contact-hook-update !>([%initial synced])]~
==
?. |(=(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
=/ cards
(handle-contact-action path.act our.bol [%remove path.act our.bol])
:_ state(synced (~(del by synced) path.act))
%- zing
:~ (pull-wire [%contacts path.act])
[%give %fact [/synced]~ %contact-hook-update !>([%initial synced])]~
cards
==
==
::
++ poke-import
|= arc=*
^- (quip card _state)
=/ sty=state-three
[%3 (remake-map ;;((tree [path ship]) +<.arc)) ;;(? +>.arc)]
:_ sty
%+ turn ~(tap by synced.sty)
|= [=path =ship]
^- card
=/ contact-path [%contacts path]
?: =(our.bol ship)
[%pass contact-path %agent [our.bol %contact-store] %watch contact-path]
(try-rejoin ship contact-path 0)
::
++ try-rejoin
|= [who=@p pax=path nack-count=@ud]
^- card
=/ =wire
[%try-rejoin (scot %ud nack-count) (scot %p who) pax]
[%pass wire %agent [who %contact-hook] %watch pax]
::
++ 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 members.group) src.bol)
=/ contacts (need (contacts-scry pax))
[%give %fact ~ %contact-update !>([%contacts pax contacts])]~
::
++ watch-synced
|= pax=path
^- (list card)
?> (team:title our.bol src.bol)
[%give %fact ~ %contact-hook-update !>([%initial synced])]~
::
++ watch-ack
|= [wir=wire saw=(unit tang)]
^- (quip card _state)
?~ saw
[~ state]
?: ?=([%try-rejoin @ *] wir)
=/ nack-count=@ud (slav %ud i.t.wir)
=/ wakeup=@da
(add now.bol (mul ~s1 (bex (min 19 nack-count))))
:_ state
[%pass wir %arvo %b %wait wakeup]~
::
?> ?=(^ wir)
[~ state(synced (~(del by synced) t.wir))]
::
++ migrate
|= wir=wire
^- wire
?> ?=([%contacts @ @ *] wir)
[%contacts %ship t.wir]
::
++ kick
|= wir=wire
^- (list card)
?+ wir !!
[%try-rejoin @ @ *]
$(wir t.t.t.wir)
::
[%inv ~]
[%pass /inv %agent [our.bol %invite-store] %watch /invitatory/contacts]~
::
[%group ~]
[%pass /group %agent [our.bol %group-store] %watch /groups]~
::
[%contacts @ *]
=/ wir
?: =(%ship i.t.wir)
wir
(migrate wir)
?> ?=([%contacts @ @ *] wir)
?. (~(has by synced) t.wir) ~
=/ =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])
::
%delete
=. synced (~(del by synced) path.fact)
`state
==
::
++ foreign
|= fact=contact-update
^- (list card)
?+ -.fact ~
%contacts
=/ owner (~(got by synced) path.fact)
?> =(owner src.bol)
=/ have-contacts=(unit contacts)
(contacts-scry path.fact)
?~ have-contacts
:: if we don't have any contacts yet,
:: create the entry, and %add every contact
::
:- (contact-poke [%create path.fact])
%+ turn ~(tap by contacts.fact)
|= [=ship =contact]
(contact-poke [%add path.fact ship contact])
:: if we already have some, decide between %add, %remove and recreate
:: on a per-contact basis
::
%- zing
%+ turn
%~ tap in
%- ~(uni in ~(key by contacts.fact))
~(key by u.have-contacts)
|= =ship
^- (list card)
=/ have=(unit contact) (~(get by u.have-contacts) ship)
=/ want=(unit contact) (~(get by contacts.fact) ship)
?~ have
[(contact-poke %add path.fact ship (need want))]~
?~ want
[(contact-poke %remove path.fact ship)]~
?: =(u.want u.have) ~
::TODO probably want an %all edit-field that resolves to more granular
:: updates within the contact-store?
:~ (contact-poke %remove path.fact ship)
(contact-poke %add path.fact ship u.want)
==
::
%add
=/ owner (~(get by synced) path.fact)
?~ owner ~
?> |(=(u.owner src.bol) =(src.bol ship.fact))
~[(contact-poke [%add path.fact ship.fact contact.fact])]
::
%remove
=/ owner (~(get by synced) path.fact)
?~ owner ~
?> |(=(u.owner src.bol) =(src.bol ship.fact))
~[(contact-poke [%remove path.fact ship.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=update:group-store]
^- (quip card _state)
?: ?=(%initial -.fact)
[~ state]
=/ group=(unit group)
(scry-group:grp resource.fact)
|^
?+ -.fact [~ state]
%initial-group (initial-group +.fact)
%remove-members (remove +.fact)
%remove-group (unbundle +.fact)
==
::
++ initial-group
|= [rid=resource =^group]
^- (quip card _state)
?: hidden.group [~ state]
=/ =path
(en-path:resource rid)
?: (~(has by synced) path)
[~ state]
(poke-hook-action %add-synced entity.rid path)
::
++ unbundle
|= [rid=resource ~]
^- (quip card _state)
=/ =path
(en-path:resource rid)
?. (~(has by synced) path)
?~ (contacts-scry path)
[~ state]
:_ state
[(contact-poke [%delete path])]~
:_ state(synced (~(del by synced) path))
:~ [%pass [%contacts path] %agent [our.bol %contact-store] %leave ~]
[(contact-poke [%delete path])]
==
::
++ remove
|= [rid=resource ships=(set ship)]
^- (quip card _state)
:: if pax is synced, remove member from contacts and kick their sub
?~ group
[~ state]
?: hidden.u.group [~ state]
=/ =path
(en-path:resource rid)
=/ owner=(unit ship) (~(get by synced) path)
?~ owner
:_ state
%+ turn ~(tap in ships)
|= =ship
(contact-poke [%remove path ship])
:_ state
%- zing
%+ turn ~(tap in ships)
|= =ship
:~ [%give %kick ~[[%contacts path]] `ship]
?: =(ship our.bol)
(contact-poke [%delete path])
(contact-poke [%remove path ship])
==
--
::
++ invite-poke
|= act=action:inv
^- 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)]
::
++ contacts-scry
|= pax=path
^- (unit contacts)
=. pax
;: weld
/(scot %p our.bol)/contact-store/(scot %da now.bol)/contacts
pax
/noun
==
.^((unit contacts) %gx pax)
::
++ group-scry
|= pax=path
.^ (unit group)
%gx
;:(weld /(scot %p our.bol)/group-store/(scot %da now.bol) /groups 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 %contact-store] %leave ~]~
[%pass pax %agent [u.shp %contact-hook] %leave ~]~
++ on-leave on-leave:def
++ on-peek on-peek:def
++ on-fail on-fail:def
--

View File

@ -0,0 +1,68 @@
/- *resource
/+ store=contact-store, contact, default-agent, verb, dbug, pull-hook, agentio
/+ grpl=group
~% %contact-pull-hook-top ..part ~
|%
+$ card card:agent:gall
++ config
^- config:pull-hook
:* %contact-store
update:store
%contact-update
%contact-push-hook
%.y :: necessary to enable p2p
==
--
::
%- agent:dbug
%+ verb |
^- 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)
io ~(. agentio bowl)
grp ~(. grpl bowl)
::
++ on-init
^- (quip card _this)
:_ this
(poke-self:pass:io noun+!>(%upgrade))^~
++ on-save !>(~)
++ on-load on-load:def
++ on-poke
|= [=mark =vase]
^- (quip card _this)
?. ?=(%noun mark) (on-poke:def mark vase)
:_ this
%+ murn ~(tap in scry-groups:grp)
|= rid=resource
?: =(our.bowl entity.rid) ~
?. (is-managed:grp rid) ~
`(poke-self:pass:io pull-hook-action+!>([%add [entity .]:rid]))
::
++ on-peek on-peek:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
++ on-agent on-agent:def
++ on-watch
|= =path
?. ?=([%nacks ~] path)
(on-watch:def path)
?> (team:title [src our]:bowl)
`this
::
++ on-leave on-leave:def
++ resource-for-update resource-for-update:con
++ on-pull-nack
|= [=resource =tang]
^- (quip card _this)
:_ this
[%give %fact ~[/nacks] resource+!>(resource)]~
::
++ on-pull-kick |=(=resource `/)
--

View File

@ -0,0 +1,129 @@
/- pull-hook
/+ store=contact-store, res=resource, contact, group,
default-agent, dbug, push-hook, agentio, verb
~% %contact-push-hook-top ..part ~
|%
+$ card card:agent:gall
++ config
^- config:push-hook
:* %contact-store
/updates
update:store
%contact-update
%contact-pull-hook
==
::
+$ agent (push-hook:push-hook config)
::
+$ share [%share =ship]
--
::
%- agent:dbug
^- agent:gall
%+ verb |
%- (agent:push-hook config)
^- agent
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
con ~(. contact bowl)
grp ~(. group bowl)
io ~(. agentio bowl)
::
++ on-init
^- (quip card _this)
:_ this
:- %+ poke-our:pass:io %contact-push-hook
:- %push-hook-action
!>(`action:push-hook`[%add [our.bowl %'']])
%+ murn ~(tap in scry-groups:grp)
|= rid=res
?. =(our.bowl entity.rid) ~
?. (is-managed:grp rid) ~
`(poke-self:pass:io push-hook-action+!>([%add rid]))
::
++ on-save !>(~)
++ on-load on-load:def
++ on-poke
|= [=mark =vase]
^- (quip card _this)
?. =(mark %contact-share) (on-poke:def mark vase)
=/ =share !<(share vase)
:_ this :_ ~
?: =(our.bowl src.bowl)
?< =(ship.share our.bowl)
:: proxy poke
%+ poke:pass:io [ship.share dap.bowl]
contact-share+!>([%share our.bowl])
:: accept share
?> =(src.bowl ship.share)
%+ poke-our:pass:io %contact-pull-hook
pull-hook-action+!>([%add src.bowl [src.bowl %$]])
::
++ 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
%set-public %.n
==
::
++ resource-for-update resource-for-update:con
::
++ initial-watch
|= [=path =resource:res]
^- vase
|^
?> (is-allowed:con resource src.bowl)
!> ^- update:store
[%initial rolo %.n]
::
++ rolo
^- rolodex:store
=/ ugroup (scry-group:grp resource)
%- ~(gas by *rolodex:store)
?~ ugroup
=/ c=(unit contact:store) (get-contact:con our.bowl)
?~ c
[our.bowl *contact:store]~
[our.bowl u.c]~
%+ murn ~(tap in (members:grp resource))
|= s=ship
^- (unit [ship contact:store])
=/ c=(unit contact:store) (get-contact:con s)
?~(c ~ `[s u.c])
--
::
++ take-update
|= =vase
^- [(list card) agent]
=/ =update:store !<(update:store vase)
?+ -.update [~ this]
%disallow
:_ this
[%give %kick ~[resource+(en-path:res [our.bowl %''])] ~]~
::
%set-public
:_ this
?. public.update
[%give %kick ~[resource+(en-path:res [our.bowl %''])] ~]~
%+ murn ~(tap in scry-groups:grp)
|= rid=res
?: =(our.bowl entity.rid) ~
?. (is-managed:grp rid) ~
`(poke-self:pass:io contact-share+!>([%share entity.rid]))
==
--

View File

@ -1,279 +1,245 @@
:: contact-store [landscape]:
::
:: data store that holds group-based contact data
:: data store that holds individual contact data
::
/+ *contact-json, default-agent, dbug, *migrate
/- store=contact-store, *resource
/+ default-agent, dbug, *migrate, contact
|%
+$ card card:agent:gall
+$ state-4
$: %4
=rolodex:store
allowed-groups=(set resource)
allowed-ships=(set ship)
is-public=_|
==
+$ versioned-state
$% state-zero
state-one
state-two
state-three
==
::
+$ rolodex-0 (map path contacts-0)
+$ contacts-0 (map ship contact-0)
+$ avatar-0 [content-type=@t octs=[p=@ud q=@t]]
+$ contact-0
$: nickname=@t
email=@t
phone=@t
website=@t
notes=@t
color=@ux
avatar=(unit avatar-0)
==
::
+$ state-zero
$: %0
rolodex=rolodex-0
==
+$ state-one
$: %1
=rolodex
==
+$ state-two
$: %2
=rolodex
==
+$ state-three
$: %3
=rolodex
$% [%0 *]
[%1 *]
[%2 *]
[%3 *]
state-4
==
--
::
=| state-three
=| state-4
=* state -
%- agent:dbug
^- agent:gall
=<
|_ =bowl:gall
+* this .
contact-core +>
cc ~(. contact-core bowl)
def ~(. (default-agent this %|) bowl)
|_ =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)]
::
++ on-init on-init:def
++ on-save !>(state)
++ on-load
|= old-vase=vase
=/ old !<(versioned-state old-vase)
=| cards=(list card)
|-
?: ?=(%3 -.old)
[cards this(state old)]
?: ?=(%2 -.old)
%_ $
-.old %3
::
rolodex.old
=/ def
(~(get by rolodex.old) /ship/~/default)
?~ def
rolodex.old
=. rolodex.old
(~(del by rolodex.old) /ship/~/default)
=. rolodex.old
(~(put by rolodex.old) /~/default u.def)
rolodex.old
==
?: ?=(%1 -.old)
=/ new-rolodex=^rolodex
%- malt
%+ turn
~(tap by rolodex.old)
|= [=path =contacts]
[ship+path contacts]
%_ $
old [%2 new-rolodex]
::
cards
=/ paths
%+ turn
~(val by sup.bol)
|=([=ship =path] path)
?~ paths cards
:_ cards
[%give %kick paths ~]
==
=/ new-rolodex=^rolodex
%- ~(run by rolodex.old)
|= cons=contacts-0
^- contacts
%- ~(run by cons)
|= con=contact-0
^- contact
:* nickname.con
email.con
phone.con
website.con
notes.con
color.con
~
==
$(old [%1 new-rolodex])
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
?> (team:title our.bowl src.bowl)
=^ cards state
?+ mark (on-poke:def mark vase)
::%json (poke-json:cc !<(json vase))
%contact-action
(poke-contact-action:cc !<(contact-action vase))
::
%import
(poke-import:cc q.vase)
==
[cards this]
::
++ on-watch
|= =path
^- (quip card _this)
?> (team:title our.bowl src.bowl)
|^
=/ cards=(list card)
?+ path (on-watch:def path)
[%all ~] (give %contact-update !>([%initial rolodex]))
[%updates ~] ~
[%contacts @ *]
%+ give %contact-update
!>([%contacts t.path (~(got by rolodex) t.path)])
==
[cards this]
%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 ~] ~
::
++ give
|= =cage
^- (list card)
[%give %fact ~ cage]~
--
::
++ on-leave on-leave:def
++ on-peek
|= =path
^- (unit (unit cage))
?+ path (on-peek:def path)
[%x %all ~] ``noun+!>(rolodex)
[%x %contacts *]
?~ t.t.path
~
``noun+!>((~(get by rolodex) t.t.path))
::
[%x %contact *]
:: /:path/:ship
=/ pax `^path`(flop t.t.path)
?~ pax ~
=/ =ship (slav %p i.pax)
?~ t.pax ~
=> .(pax `(list @ta)`(flop t.pax))
=/ contacts=(unit contacts) (~(get by rolodex) pax)
?~ contacts
~
``noun+!>((~(get by u.contacts) ship))
::
[%x %export ~]
``noun+!>(state)
[%our ~]
%- give
:+ %add
our.bowl
=/ contact=(unit contact:store) (~(get by rolodex) our.bowl)
?~ contact *contact:store
u.contact
==
[cards this]
::
++ on-agent on-agent:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
++ give
|= =update:store
^- (list card)
[%give %fact ~ [%contact-update !>(update)]]~
--
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
?> (team:title our.bowl src.bowl)
|^
=^ cards state
?+ mark (on-poke:def mark vase)
%contact-update (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 is-public=?]
^- (quip card _state)
=/ our-contact (~(got by rolodex) our.bowl)
=. rolodex (~(uni by rolodex) rolo)
=. rolodex (~(put by rolodex) our.bowl our-contact)
:_ state(rolodex rolodex)
(send-diff [%initial rolodex 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]
=. last-updated.contact now.bowl
:- (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]
|^
^- (quip card _state)
=/ old (~(got by rolodex) ship)
=/ contact (edit-contact old edit-field)
?: =(old contact)
[~ state]
=. last-updated.contact now.bowl
:- (send-diff [%edit ship edit-field] =(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 !>(update)]~
--
::
++ import
|= arc=*
^- (quip card _state)
:: note: we are purposefully wiping all state before state-4
[~ *state-4]
--
::
|_ bol=bowl:gall
::
::++ poke-json
:: |= =json
:: ^- (quip move _this)
:: ?> (team:title our.bol src.bol)
:: (poke-contact-action (json-to-action json))
::
++ poke-contact-action
|= action=contact-action
^- (quip card _state)
?> (team:title our.bol src.bol)
?- -.action
%create (handle-create +.action)
%delete (handle-delete +.action)
%add (handle-add +.action)
%remove (handle-remove +.action)
%edit (handle-edit +.action)
++ 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
!> ^- 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))
==
::
++ poke-import
|= arc=*
^- (quip card _state)
=/ sty=state-three
:- %3
%- remake-map-of-map
;;((tree [path (tree [ship contact])]) +.arc)
[~ sty]
::
++ handle-create
|= =path
^- (quip card _state)
?< (~(has by rolodex) path)
:- (send-diff path [%create path])
state(rolodex (~(put by rolodex) path *contacts))
::
++ handle-delete
|= =path
^- (quip card _state)
?. (~(has by rolodex) path) [~ state]
:- (send-diff path [%delete path])
state(rolodex (~(del by rolodex) path))
::
++ handle-add
|= [=path =ship =contact]
^- (quip card _state)
=/ contacts (~(got by rolodex) path)
?< (~(has by contacts) ship)
=. contacts (~(put by contacts) ship contact)
:- (send-diff path [%add path ship contact])
state(rolodex (~(put by rolodex) path contacts))
::
++ handle-remove
|= [=path =ship]
^- (quip card _state)
=/ contacts (~(got by rolodex) path)
?. (~(has by contacts) ship) [~ state]
=. contacts (~(del by contacts) ship)
:- (send-diff path [%remove path ship])
state(rolodex (~(put by rolodex) path contacts))
::
++ handle-edit
|= [=path =ship =edit-field]
^- (quip card _state)
=/ contacts (~(got by rolodex) path)
=/ contact (~(got by contacts) ship)
=. contact (edit-contact contact edit-field)
=. contacts (~(put by contacts) ship contact)
:- (send-diff path [%edit path ship edit-field])
state(rolodex (~(put by rolodex) path contacts))
::
++ edit-contact
|= [con=contact edit=edit-field]
^- contact
?- -.edit
%nickname con(nickname nickname.edit)
%email con(email email.edit)
%phone con(phone phone.edit)
%website con(website website.edit)
%notes con(notes notes.edit)
%color con(color color.edit)
%avatar con(avatar avatar.edit)
==
::
++ send-diff
|= [pax=path upd=contact-update]
^- (list card)
:~ :*
%give %fact
~[/all /updates [%contacts pax]]
%contact-update !>(upd)
== ==
++ on-leave on-leave:def
++ on-agent on-agent:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
--

View File

@ -1,342 +1,27 @@
:: contact-view [landscape]:
::
:: sets up contact JS client and combines commands
:: into semantic actions for the UI
::
/-
inv=invite-store,
*contact-hook,
*metadata-store,
*metadata-hook,
pull-hook,
push-hook
/+ *server, *contact-json, default-agent, dbug, verb,
grpl=group, mdl=metadata, resource,
group-store
:: contact-view [landscape]: deprecated
::
/+ default-agent
|%
+$ versioned-state
$% state-0
==
::
+$ state-0
$: %0
~
==
::
+$ card card:agent:gall
--
=| state-0
=* state -
::
%- agent:dbug
%+ verb |
^- agent:gall
=<
|_ =bowl:gall
+* this .
contact-core +>
cc ~(. contact-core bowl)
def ~(. (default-agent this %|) bowl)
::
++ on-init
^- (quip card _this)
:_ this
:~ [%pass /updates %agent [our.bowl %contact-store] %watch /updates]
(contact-poke:cc [%create /~/default])
(contact-poke:cc [%add /~/default our.bowl *contact])
:* %pass /srv %agent [our.bol %file-server]
%poke %file-server-action
!>([%serve-dir /'~groups' /app/landscape %.n %.y])
==
==
::
++ on-save !>(state)
++ on-load
|= old-vase=vase
^- (quip card _this)
=/ old ((soft state-0) q.old-vase)
?^ old [~ this]
:_ this(state [%0 ~])
:~ [%pass / %arvo %e %disconnect [~ /'~groups']]
[%pass / %arvo %e %connect [~ /'contact-view'] %contact-view]
:* %pass /srv %agent [our.bol %file-server]
%poke %file-server-action
!>([%serve-dir /'~groups' /app/landscape %.n %.y])
==
==
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
?> (team:title our.bowl src.bowl)
?+ mark (on-poke:def mark vase)
%json [(poke-json:cc !<(json vase)) this]
%contact-view-action
[(poke-contact-view-action:cc !<(contact-view-action vase)) this]
::
%handle-http-request
=+ !<([eyre-id=@ta =inbound-request:eyre] vase)
:_ this
%+ give-simple-payload:app eyre-id
%+ require-authorization:app inbound-request
poke-handle-http-request:cc
==
::
++ on-watch
|= =path
^- (quip card _this)
?> (team:title our.bowl src.bowl)
?: ?=([%http-response *] path) [~ this]
?. =(/primary path) (on-watch:def path)
[[%give %fact ~ %json !>((update-to-json [%initial all-scry:cc]))]~ this]
::
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
?+ -.sign (on-agent:def wire sign)
%poke-ack
?. ?=([%join-group %ship @ @ ~] wire)
(on-agent:def wire sign)
?^ p.sign
(on-agent:def wire sign)
:_ this
(joined-group:cc t.wire)
::
%kick
[[%pass / %agent [our.bol %contact-store] %watch /updates]~ this]
::
%fact
?+ p.cage.sign (on-agent:def wire sign)
%contact-update
=/ update=json (update-to-json !<(contact-update q.cage.sign))
[[%give %fact ~[/primary] %json !>(update)]~ this]
==
==
::
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card _this)
?. ?=(%bound +<.sign-arvo)
(on-arvo:def wire sign-arvo)
[~ this]
::
++ on-leave on-leave:def
++ on-peek on-peek:def
++ on-fail on-fail:def
--
::
|_ bol=bowl:gall
++ grp ~(. grpl bol)
++ md ~(. mdl bol)
++ poke-json
|= jon=json
^- (list card)
?> (team:title our.bol src.bol)
(poke-contact-view-action (json-to-view-action jon))
+* this .
def ~(. (default-agent this %|) bol)
::
++ poke-contact-view-action
|= act=contact-view-action
^- (list card)
?> (team:title our.bol src.bol)
?- -.act
%create
=/ rid=resource
[our.bol name.act]
=/ =path
(en-path:resource rid)
;: weld
:~ (group-poke [%add-group rid policy.act %.n])
(group-poke [%add-members rid (sy our.bol ~)])
(group-push-poke %add rid)
(contact-poke [%create path])
(contact-hook-poke [%add-owned path])
==
(create-metadata path title.act description.act)
?. ?=(%invite -.policy.act)
~
%+ turn
~(tap in pending.policy.act)
|= =ship
(send-invite our.bol %contacts rid ship '')
==
::
%join
=/ =cage
:- %group-update
!> ^- update:group-store
[%add-members resource.act (sy our.bol ~)]
=/ =wire
[%join-group (en-path:resource resource.act)]
[%pass wire %agent [entity.resource.act %group-push-hook] %poke cage]~
::
%invite
=* rid resource.act
=/ =group (need (scry-group:grp rid))
:- (send-invite entity.rid %contacts rid ship.act text.act)
?. ?=(%invite -.policy.group) ~
~[(add-pending rid ship.act)]
::
%delete
~
::
%remove
=/ rid=resource
(de-path:resource path.act)
:~ (group-poke %remove-members rid (sy ship.act ~))
(contact-poke [%remove path.act ship.act])
==
::
%share
:: determine whether to send to our contact-hook or foreign
:: send contact-action to contact-hook with %add action
[(share-poke recipient.act [%add path.act ship.act contact.act])]~
::
%groupify
=/ =path
(en-path:resource resource.act)
%+ weld
:~ (group-poke %expose resource.act ~)
(contact-poke [%create path])
(contact-hook-poke [%add-owned path])
==
(create-metadata path title.act description.act)
==
++ poke-handle-http-request
|= =inbound-request:eyre
^- simple-payload:http
=+ url=(parse-request-line url.request.inbound-request)
=/ name=@t
=+ back-path=(flop site.url)
?~ back-path
''
i.back-path
?+ site.url not-found:gen
[%'contact-view' @ *]
=/ =path (flop t.t.site.url)
?~ path not-found:gen
=/ contact (contact-scry `^path`(snoc (flop t.path) name))
?~ contact not-found:gen
?~ avatar.u.contact not-found:gen
?- -.u.avatar.u.contact
%url [[307 ['location' url.u.avatar.u.contact]~] ~]
%octt
=/ max-3-days ['cache-control' 'max-age=259200']
=/ content-type ['content-type' content-type.u.avatar.u.contact]
[[200 [content-type max-3-days ~]] `octs.u.avatar.u.contact]
==
==
++ on-init on-init:def
++ on-poke on-poke:def
++ on-watch on-watch:def
++ on-agent on-agent:def
++ on-arvo on-arvo:def
++ on-save !>(~)
++ on-load
|= old-vase=vase
^- (quip card _this)
[~ this]
::
++ joined-group
|= =path
^- (list card)
=/ rid=resource
(de-path:resource path)
:~ (group-pull-poke [%add entity.rid rid])
(contact-hook-poke [%add-synced entity.rid path])
(sync-metadata entity.rid path)
==
::
:: +utilities
::
++ add-pending
|= [rid=resource =ship]
^- card
=/ app=term
?: =(our.bol entity.rid)
%group-store
%group-push-hook
=/ =cage
:- %group-update
!> ^- action:group-store
[%change-policy rid %invite %add-invites (sy ship ~)]
[%pass / %agent [entity.rid app] %poke cage]
::
++ send-invite
|= =invite:inv
^- card
=/ =cage
:- %invite-action
!> ^- action:inv
[%invite %contacts (shaf %invite-uid eny.bol) invite]
[%pass / %agent [recipient.invite %invite-hook] %poke cage]
::
++ contact-poke
|= act=contact-action
^- card
[%pass / %agent [our.bol %contact-store] %poke %contact-action !>(act)]
::
++ contact-hook-poke
|= act=contact-hook-action
^- card
[%pass / %agent [our.bol %contact-hook] %poke %contact-hook-action !>(act)]
::
++ share-poke
|= [=ship act=contact-action]
^- card
[%pass / %agent [ship %contact-hook] %poke %contact-action !>(act)]
::
++ group-poke
|= act=action:group-store
^- card
[%pass / %agent [our.bol %group-store] %poke %group-action !>(act)]
::
++ group-push-poke
|= act=action:push-hook
^- card
[%pass / %agent [our.bol %group-push-hook] %poke %push-hook-action !>(act)]
::
++ group-proxy-poke
|= act=action:group-store
^- card
[%pass / %agent [entity.resource.act %group-push-hook] %poke %group-update !>(act)]
::
++ group-pull-poke
|= act=action:pull-hook
^- card
[%pass / %agent [our.bol %group-pull-hook] %poke %pull-hook-action !>(act)]
::
++ metadata-poke
|= act=metadata-action
^- card
[%pass / %agent [our.bol %metadata-store] %poke %metadata-action !>(act)]
::
++ metadata-hook-poke
|= act=metadata-hook-action
^- card
[%pass / %agent [our.bol %metadata-hook] %poke %metadata-hook-action !>(act)]
::
++ sync-metadata
|= [=ship =path]
^- card
(metadata-hook-poke %add-synced ship path)
::
++ create-metadata
|= [=path title=@t description=@t]
^- (list card)
=/ =metadata
%* . *metadata
title title
description description
date-created now.bol
creator our.bol
==
:~ (metadata-poke [%add path [%contacts path] metadata])
(metadata-hook-poke [%add-owned path])
==
::
++ all-scry
^- rolodex
.^(rolodex %gx /(scot %p our.bol)/contact-store/(scot %da now.bol)/all/noun)
::
++ contact-scry
|= pax=path
^- (unit contact)
=. pax
;: weld
/(scot %p our.bol)/contact-store/(scot %da now.bol)/contact
pax
/noun
==
.^((unit contact) %gx pax)
++ on-leave on-leave:def
++ on-peek on-peek:def
++ on-fail on-fail:def
--

View File

@ -213,6 +213,9 @@
(lowercase (weld path.content.u.content suffix.u.content))
==
?. .^(? %cu scry-path) [not-found:gen %.n]
?: ?=([~ %woff2] ext.req-line)
:_ public.u.content
[[200 [['content-type' '/font/woff2'] ~]] `.^(octs %cx scry-path)]
=/ file (as-octs:mimes:html .^(@ %cx scry-path))
:_ public.u.content
?+ ext.req-line not-found:gen

View File

@ -5,7 +5,7 @@
/- glob
/+ default-agent, verb, dbug
|%
++ hash 0v2.n1md9.trksl.p71td.ctngq.rr9su
++ hash 0v7.d72b8.89c7k.vn1je.k3gvs.qr60j
+$ state-0 [%0 hash=@uv glob=(unit (each glob:glob tid=@ta))]
+$ all-states
$% state-0

View File

@ -9,10 +9,12 @@
update:store
%graph-update
%graph-push-hook
%.n
==
--
::
%- agent:dbug
%+ verb |
^- agent:gall
%- (agent:pull-hook config)
^- (pull-hook:pull-hook config)
@ -35,6 +37,7 @@
++ on-pull-nack
|= [=resource =tang]
^- (quip card _this)
%- (slog leaf+"nacked {<resource>}" tang)
:_ this
?. (~(has in get-keys:gra) resource) ~
=- [%pass /pull-nack %agent [our.bowl %graph-store] %poke %graph-update -]~
@ -47,4 +50,6 @@
=/ maybe-time (peek-update-log:gra resource)
?~ maybe-time `/
`/(scot %da u.maybe-time)
::
++ resource-for-update resource-for-update:gra
--

View File

@ -1,11 +1,7 @@
/+ store=graph-store
/+ metadata
/+ res=resource
/+ graph
/+ group
/+ default-agent
/+ dbug
/+ push-hook
/- *group, metadata=metadata-store
/+ store=graph-store, mdl=metadata, res=resource, graph, group, default-agent,
dbug, verb, push-hook
::
~% %graph-push-hook-top ..part ~
|%
+$ card card:agent:gall
@ -20,82 +16,84 @@
::
+$ agent (push-hook:push-hook config)
::
++ is-allowed
|= [=resource:res =bowl:gall requires-admin=?]
^- ?
=/ grp ~(. group bowl)
=/ met ~(. metadata bowl)
=/ group-paths (groups-from-resource:met [%graph (en-path:res resource)])
?~ group-paths %.n
?: requires-admin
(is-admin:grp src.bowl i.group-paths)
?| (is-member:grp src.bowl i.group-paths)
(is-admin:grp src.bowl i.group-paths)
==
::
++ is-allowed-remove
|= [=resource:res indices=(set index:store) =bowl:gall]
^- ?
=/ gra ~(. graph bowl)
?. (is-allowed resource bowl %.n)
%.n
%+ levy
~(tap in indices)
|= =index:store
^- ?
=/ =node:store
(got-node:gra resource index)
?| =(author.post.node src.bowl)
(is-allowed resource bowl %.y)
==
+$ state-null ~
+$ state-zero [%0 marks=(set mark)]
+$ versioned-state
$@ state-null
state-zero
--
::
=| state-zero
=* state -
%- agent:dbug
%+ verb |
^- agent:gall
%- (agent:push-hook config)
^- agent
=<
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
grp ~(. group bowl)
gra ~(. graph bowl)
hc ~(. +> bowl)
::
++ on-init on-init:def
++ on-save !>(~)
++ on-load on-load:def
++ on-save !>(state)
++ on-load
|= =vase
=+ !<(old=versioned-state vase)
=? old ?=(~ old)
[%0 ~]
?> ?=(%0 -.old)
`this(state old)
::
++ 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-arvo
|= [=wire =sign-arvo]
^- (quip card _this)
?+ wire (on-arvo:def wire sign-arvo)
::
[%perms @ @ ~]
?> ?=(?(%add %remove) i.t.t.wire)
=* mark i.t.wire
:_ this
(build-permissions mark i.t.t.wire %next)^~
==
::
++ on-fail on-fail:def
::
++ should-proxy-update
|= =vase
^- ?
=/ =update:store !<(update:store vase)
=* rid resource.q.update
?- -.q.update
%add-graph (is-allowed resource.q.update bowl %.y)
%remove-graph (is-allowed resource.q.update bowl %.y)
%add-nodes (is-allowed resource.q.update bowl %.n)
%remove-nodes (is-allowed-remove resource.q.update indices.q.update bowl)
%add-signatures (is-allowed resource.uid.q.update bowl %.n)
%remove-signatures (is-allowed resource.uid.q.update bowl %.y)
%archive-graph (is-allowed resource.q.update bowl %.y)
%add-graph %.n
%remove-graph %.n
%add-nodes (is-allowed-add:hc resource.q.update nodes.q.update)
%remove-nodes (is-allowed-remove:hc resource.q.update indices.q.update)
%add-signatures %.n
%remove-signatures %.n
%archive-graph %.n
%unarchive-graph %.n
%add-tag %.n
%remove-tag %.n
%keys %.n
%tags %.n
%tag-queries %.n
%run-updates (is-allowed resource.q.update bowl %.y)
%run-updates %.n
==
++ resource-for-update resource-for-update:gra
::
++ initial-watch
|= [=path =resource:res]
^- vase
?> (is-allowed resource bowl %.n)
?> (is-allowed:hc resource)
!> ^- update:store
?~ path
:: new subscribe
@ -114,6 +112,15 @@
^- [(list card) agent]
=/ =update:store !<(update:store vase)
?+ -.q.update [~ this]
%add-graph
?~ mark.q.update `this
=* mark u.mark.q.update
?: (~(has in marks) mark) `this
:_ this(marks (~(put in marks) mark))
:~ (build-permissions:hc mark %add %sing)
(build-permissions:hc mark %remove %sing)
==
::
%remove-graph
:_ this
[%give %kick ~[resource+(en-path:res resource.q.update)] ~]~
@ -123,3 +130,138 @@
[%give %kick ~[resource+(en-path:res resource.q.update)] ~]~
==
--
|_ =bowl:gall
+* grp ~(. group bowl)
met ~(. mdl bowl)
gra ~(. graph bowl)
++ scry
|= [care=@t desk=@t =path]
%+ weld
/[care]/(scot %p our.bowl)/[desk]/(scot %da now.bowl)
path
::
++ scry-mark
|= =resource:res
.^ (unit mark)
(scry %gx %graph-store /graph-mark/(scot %p entity.resource)/[name.resource]/noun)
==
::
++ perm-mark-name
|= perm=@t
^- @t
(cat 3 'graph-permissions-' perm)
::
++ perm-mark
|= [=resource:res perm=@t vip=vip-metadata:metadata =indexed-post:store]
^- permissions:store
=- (check vip)
!< check=$-(vip-metadata:metadata permissions:store)
%. !>(indexed-post)
=/ mark (get-mark:gra resource)
?~ mark |=(=vase !>([%no %no %no]))
.^(tube:clay (scry %cc %home /[u.mark]/(perm-mark-name perm)))
::
++ add-mark
|= [=resource:res vip=vip-metadata:metadata =indexed-post:store]
(perm-mark resource %add vip indexed-post)
::
++ remove-mark
|= [=resource:res vip=vip-metadata:metadata =indexed-post:store]
(perm-mark resource %remove vip indexed-post)
::
++ get-permission
|= [=permissions:store is-admin=? writers=(set ship)]
^- permission-level:store
?: is-admin
admin.permissions
?: =(~ writers)
writer.permissions
?: (~(has in writers) src.bowl)
writer.permissions
reader.permissions
::
++ is-allowed
|= =resource:res
=/ group-res=resource:res
(need (peek-group:met %graph resource))
(is-member:grp src.bowl group-res)
::
++ get-roles-writers-variation
|= =resource:res
^- (unit [is-admin=? writers=(set ship) vip=vip-metadata:metadata])
=/ assoc=(unit association:metadata)
(peek-association:met %graph resource)
?~ assoc ~
=/ role=(unit (unit role-tag))
(role-for-ship:grp group.u.assoc src.bowl)
=/ writers=(set ship)
(get-tagged-ships:grp group.u.assoc [%graph resource %writers])
?~ role ~
=/ is-admin=?
?=(?([~ %admin] [~ %moderator]) u.role)
`[is-admin writers vip.metadatum.u.assoc]
::
++ node-to-indexed-post
|= =node:store
^- indexed-post:store
=* index index.post.node
[(snag (dec (lent index)) index) post.node]
::
++ is-allowed-add
|= [=resource:res nodes=(map index:store node:store)]
^- ?
%- (bond |.(%.n))
%+ biff (get-roles-writers-variation resource)
|= [is-admin=? writers=(set ship) vip=vip-metadata:metadata]
%- some
%+ levy ~(tap by nodes)
|= [=index:store =node:store]
=/ =permissions:store
%^ add-mark resource vip
(node-to-indexed-post node)
=/ =permission-level:store
(get-permission permissions is-admin writers)
~& permission-level
?- permission-level
%yes %.y
%no %.n
::
%self
=/ parent-index=index:store
(scag (dec (lent index)) index)
=/ parent-node=node:store
(got-node:gra resource parent-index)
=(author.post.parent-node src.bowl)
==
::
++ is-allowed-remove
|= [=resource:res indices=(set index:store)]
^- ?
%- (bond |.(%.n))
%+ biff (get-roles-writers-variation)
|= [is-admin=? writers=(set ship) vip=vip-metadata:metadata]
%- some
%+ levy ~(tap by indices)
|= =index:store
=/ =node:store
(got-node:gra resource index)
=/ =permissions:store
%^ remove-mark resource vip
(node-to-indexed-post node)
=/ =permission-level:store
(get-permission permissions is-admin writers)
?- permission-level
%yes %.y
%no %.n
%self =(author.post.node src.bowl)
==
::
++ build-permissions
|= [=mark kind=?(%add %remove) mode=?(%sing %next)]
^- card
=/ =wire /perms/[mark]/[kind]
=/ =mood:clay [%c da+now.bowl /[mark]/(perm-mark-name kind)]
=/ =rave:clay ?:(?=(%sing mode) [mode mood] [mode mood])
[%pass wire %arvo %c %warp our.bowl %home `rave]
--

View File

@ -1,7 +1,7 @@
:: graph-store [landscape]
::
::
/+ store=graph-store, sigs=signatures, res=resource, default-agent, dbug,
/+ store=graph-store, sigs=signatures, res=resource, default-agent, dbug, verb,
*migrate
~% %graph-store-top ..part ~
|%
@ -25,6 +25,7 @@
=* state -
::
%- agent:dbug
%+ verb |
^- agent:gall
~% %graph-store-agent ..card ~
|_ =bowl:gall

View File

@ -14,6 +14,7 @@
update:store
%group-update
%group-push-hook
%.n
==
::
--
@ -28,6 +29,7 @@
+* this .
def ~(. (default-agent this %|) bowl)
dep ~(. (default:pull-hook this config) bowl)
grp ~(. grpl bowl)
::
++ on-init on-init:def
++ on-save !>(~)
@ -45,8 +47,11 @@
:_ this
=- [%pass / %agent [our.bowl %group-store] %poke -]~
group-update+!>([%remove-group resource ~])
::
++ on-pull-kick
|= =resource
^- (unit path)
`/
::
++ resource-for-update resource-for-update:grp
--

View File

@ -36,7 +36,68 @@
++ on-init on-init:def
++ on-save !>(~)
++ on-load on-load:def
++ on-poke on-poke:def
++ on-poke
|= [=mark =vase]
^- (quip card _this)
|^
?. =(mark %sane)
(on-poke:def mark vase)
[sane this]
::
++ scry-sharing
.^ (set resource)
%gx
(scot %p our.bowl)
%group-push-hook
(scot %da now.bowl)
/sharing/noun
==
::
++ sane
^- (list card)
%+ 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) subs)
?~ 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
@ -80,6 +141,7 @@
=(~(tap in ships.update) ~[src.bowl])
==
--
++ resource-for-update resource-for-update:grp
::
++ take-update
|= =vase

View File

@ -29,7 +29,7 @@
:: Modify the group. Further documented in /sur/group-store.hoon
::
::
/- *group, *contact-view
/- *group
/+ store=group-store, default-agent, verb, dbug, resource, *migrate
|%
+$ card card:agent:gall
@ -37,26 +37,24 @@
+$ versioned-state
$% state-zero
state-one
state-two
==
::
+$ state-zero
$: %0
=groups:state-zero:store
==
::
[%0 *]
::
+$ state-one
$: %1
=groups
=groups:groups-state-one
==
::
+$ diff
$% [%group-update update:store]
[%group-initial groups]
+$ state-two
$: %2
=groups
==
--
::
=| state-one
=| state-two
=* state -
::
%- agent:dbug
@ -74,90 +72,37 @@
++ on-load
|= =old=vase
=/ old !<(versioned-state old-vase)
?: ?=(%1 -.old)
`this(state old)
|^
:- :~ [%pass / %agent [our.bowl dap.bowl] %poke %noun !>(%perm-upgrade)]
kick-all
==
=* paths ~(key by groups.old)
=/ [unmanaged=(list path) managed=(list path)]
(skid ~(tap in paths) |=(=path =('~' (snag 0 path))))
=. groups (all-unmanaged unmanaged)
=. groups (all-managed managed)
this
::
++ all-managed
|= paths=(list path)
^+ groups
?~ paths
groups
=/ [rid=resource =group]
(migrate-group i.paths)
%= $
paths t.paths
::
groups
(~(put by groups) rid group)
?- -.old
%2 `this(state old)
::
%1
%_ $
-.old %2
groups.old (groups-1-to-2 groups.old)
==
::
%0 $(old *state-two)
==
::
++ all-unmanaged
|= paths=(list path)
^+ groups
?~ paths
groups
?: |(=(/~/default i.paths) =(4 (lent i.paths)))
$(paths t.paths)
=/ [=resource =group]
(migrate-unmanaged i.paths)
%= $
paths t.paths
::
groups
(~(put by groups) resource group)
==
++ kick-all
^- card
:+ %give %kick
:_ ~
%~ tap by
%+ roll ~(val by sup.bowl)
|= [[=ship pax=path] paths=(set path)]
(~(put in paths) pax)
::
++ migrate-unmanaged
|= pax=path
^- [resource group]
=/ members=(set ship)
(~(got by groups.old) pax)
=| =invite:policy
?> ?=(^ pax)
=/ rid=resource
(resource-from-old-path t.pax)
++ groups-1-to-2
|= =groups:groups-state-one
^+ ^groups
%- ~(run by groups)
|= =group:groups-state-one
=/ =tags
(~(put ju *tags) %admin entity.rid)
:- rid
[members tags invite %.y]
::
++ resource-from-old-path
|= pax=path
^- resource
?> ?=([@ @ *] pax)
=/ ship
(slav %p i.pax)
[ship i.t.pax]
::
++ migrate-group
|= pax=path
=/ members
(~(got by groups.old) pax)
=| =invite:policy
=/ rid=resource
(resource-from-old-path pax)
=/ =tags
(~(put ju *tags) %admin entity.rid)
[rid members tags invite %.n]
(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]
--
::
++ on-poke
@ -189,17 +134,7 @@
^- (unit (unit cage))
?+ path (on-peek:def path)
[%y %groups ~]
=/ =arch
:- ~
%- malt
%+ turn
~(tap by groups)
|= [rid=resource *]
^- [@ta ~]
=/ group=^path
(en-path:resource rid)
[(spat group) ~]
``noun+!>(arch)
``noun+!>(~(key by groups))
::
[%x %groups %ship @ @ ~]
=/ rid=(unit resource)
@ -283,8 +218,8 @@
|= arc=*
^- (quip card _state)
|^
=/ sty=state-one
[%1 (remake-groups ;;((tree [resource tree-group]) +.arc))]
=/ sty=state-two
[%2 (remake-groups ;;((tree [resource tree-group]) +.arc))]
:_ sty
%+ roll ~(tap by groups.sty)
|= [[rid=resource grp=group] out=(list card)]
@ -294,11 +229,8 @@
|= [recipient=@p out=(list card)]
?: =(recipient our.bol)
out
:_ out
%- poke-contact
:* %invite rid recipient
(crip "Rejoin disconnected group {<entity.rid>}/{<name.rid>}")
==
:: TODO: figure out contacts integration
out
:_ out
(try-rejoin rid 0)
::
@ -620,11 +552,6 @@
|= =action:store
^- card
[%pass / %agent [our.bol %group-store] %poke %group-action !>(action)]
::
++ poke-contact
|= act=contact-view-action
^- card
[%pass / %agent [our.bol %contact-view] %poke %contact-view-action !>(act)]
:: +send-diff: update subscribers of new state
::
:: We only allow subscriptions on /groups

View File

@ -0,0 +1,250 @@
/- view-sur=group-view, group-store, *group, metadata=metadata-store
/+ default-agent, agentio, mdl=metadata,
resource, dbug, grpl=group, conl=contact, verb
|%
++ card card:agent:gall
+$ state-zero
$: %0
joining=(map rid=resource [=ship =progress:view])
==
++ view view-sur
--
=| state-zero
=* state -
::
%- agent:dbug
%+ verb |
^- agent:gall
=<
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
gc ~(. +> bowl)
io ~(. agentio bowl)
++ on-init
`this
++ on-save
!>(state)
::
++ on-load
|= =vase
=+ !<(old=state-zero vase)
`this(state old)
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
?. ?=(?(%group-view-action %noun) mark)
(on-poke:def mark vase)
=+ !<(=action:view vase)
?> ?=(%join -.action)
=^ cards state
jn-abet:(jn-start:join:gc +.action)
[cards this]
::
++ on-watch
|= =path
?+ path (on-watch:def path)
[%all ~]
:_ this
:_ ~
%+ fact:io
:- %group-view-update
!> ^- update:view
[%initial (~(run by joining) |=([=ship =progress:view] progress))]
~
==
::
++ on-peek on-peek:def
::
++ on-agent
|= [=wire =sign:agent:gall]
=^ cards state
?+ wire `state
[%join %ship @ @ *]
=/ rid
(de-path:resource t.wire)
?. (~(has by joining) rid) `state
jn-abet:(jn-agent:(jn-abed:join:gc rid) t.t.t.t.wire sign)
==
[cards this]
::
++ on-arvo on-arvo:def
++ on-leave on-leave:def
++ on-fail on-fail:def
--
|_ =bowl:gall
++ met ~(. mdl bowl)
++ grp ~(. grpl bowl)
++ io ~(. agentio bowl)
++ con ~(. conl bowl)
::
::
++ join
|_ [rid=resource =ship cards=(list card)]
++ jn-core .
++ emit-many
|= crds=(list card)
jn-core(cards (weld (flop crds) cards))
::
++ emit
|= =card
jn-core(cards [card cards])
::
++ tx-progress
|= =progress:view
=. joining
(~(put by joining) rid [ship progress])
=; =cage
(emit (fact:io cage /all tx+(en-path:resource rid) ~))
group-view-update+!>([%progress rid progress])
::
++ watch-md
(emit (watch-our:(jn-pass-io /md) %metadata-store /updates))
::
++ watch-groups
(emit (watch-our:(jn-pass-io /groups) %group-store /groups))
::
++ jn-pass-io
|= pax=path
~(. pass:io (welp join+(en-path:resource rid) pax))
::
++ jn-abed
|= r=resource
=/ [s=^ship =progress:view]
(~(got by joining) r)
jn-core(rid r, ship s)
::
++ jn-abet
^- (quip card _state)
[(flop cards) state]
::
++ jn-start
|= [rid=resource =^ship]
^+ jn-core
?< (~(has by joining) rid)
=. joining
(~(put by joining) rid [ship %start])
=. jn-core
(jn-abed rid)
=/ maybe-group
(peek-group:met %groups rid)
?^ maybe-group
~|("already joined group {<rid>}" !!)
=. jn-core
%- emit
%+ poke:(jn-pass-io /add)
[ship %group-push-hook]
group-update+!>([%add-members rid (silt our.bowl ~)])
=. jn-core (tx-progress %start)
=> watch-md
watch-groups
::
++ jn-agent
|= [=wire =sign:agent:gall]
^+ jn-core
|^
?+ -.wire ~|("bad %join wire" !!)
%add :: join group
?> ?=(%poke-ack -.sign)
?^ p.sign
(cleanup %no-perms)
=> %- emit
%+ poke-our:(jn-pass-io /pull-groups) %group-pull-hook
pull-hook-action+!>([%add ship rid])
(tx-progress %added)
::
%pull-groups
?> ?=(%poke-ack -.sign)
(ack +.sign)
::
%groups
?+ -.sign !!
%fact (groups-fact +.sign)
%watch-ack (ack +.sign)
%kick watch-groups
==
::
%pull-md
?> ?=(%poke-ack -.sign)
(ack +.sign)
::
%pull-co
?> ?=(%poke-ack -.sign)
(ack +.sign)
::
%share-co
?> ?=(%poke-ack -.sign)
(ack +.sign)
::
%push-co
?> ?=(%poke-ack -.sign)
(ack +.sign)
::
%md
?+ -.sign !!
%fact (md-fact +.sign)
%watch-ack (ack +.sign)
%kick watch-md
==
::
%pull-graphs
?> ?=(%poke-ack -.sign)
%- cleanup
?^(p.sign %strange %done)
==
::
++ groups-fact
|= =cage
?. ?=(%group-update p.cage) jn-core
=+ !<(=update:group-store q.cage)
?. ?=(%initial-group -.update) jn-core
?. =(rid resource.update) jn-core
%- emit-many
=/ cag=^cage pull-hook-action+!>([%add [entity .]:rid])
%- zing
:~ [(poke-our:(jn-pass-io /pull-md) %metadata-pull-hook cag)]~
[(poke-our:(jn-pass-io /pull-co) %contact-pull-hook cag)]~
::
?. scry-is-public:con ~
:_ ~
%+ poke:(jn-pass-io /share-co)
[entity.rid %contact-push-hook]
[%contact-share !>([%share our.bowl])]
==
::
++ md-fact
|= [=mark =vase]
?. ?=(%metadata-update mark) jn-core
=+ !<(=update:metadata vase)
?. ?=(%initial-group -.update) jn-core
?. =(group.update rid) jn-core
=. jn-core (cleanup %done)
?. hidden:(need (scry-group:grp rid)) jn-core
%- emit-many
%+ murn ~(tap by associations.update)
|= [=md-resource:metadata =association:metadata]
^- (unit card)
?. =(app-name.md-resource %graph) ~
=* rid resource.md-resource
:- ~
%+ poke-our:(jn-pass-io /pull-graph) %graph-pull-hook
pull-hook-action+!>([%add [entity .]:rid])
::
++ ack
|= err=(unit tang)
?~ err jn-core
%- (slog u.err)
(cleanup %strange)
::
++ cleanup
|= =progress:view
=. jn-core
(tx-progress progress)
=. joining (~(del by joining) rid)
=. jn-core
(emit (leave-our:(jn-pass-io /groups) %group-store))
(emit (leave-our:(jn-pass-io /md) %metadata-store))
--
--
--

View File

@ -1,7 +1,7 @@
:: hark-graph-hook: notifications for graph-store [landscape]
::
/- post, group-store, metadata-store, hook=hark-graph-hook, store=hark-store
/+ resource, metadata, default-agent, dbug, graph-store, graph, grouplib=group, store=hark-store
/- post, group-store, metadata=metadata-store, hook=hark-graph-hook, store=hark-store
/+ resource, mdl=metadata, default-agent, dbug, graph-store, graph, grouplib=group, store=hark-store
::
::
~% %hark-graph-hook-top ..part ~
@ -53,7 +53,7 @@
+* this .
ha ~(. +> bowl)
def ~(. (default-agent this %|) bowl)
met ~(. metadata bowl)
met ~(. mdl bowl)
grp ~(. grouplib bowl)
gra ~(. graph bowl)
::
@ -272,14 +272,14 @@
rid=resource
==
=/ group=(unit resource)
(group-from-app-resource:met %graph rid)
(peek-group:met %graph rid)
?~ group
~& no-group+rid
`state
=/ metadata=(unit metadata:metadata-store)
(peek-metadata:met %graph u.group rid)
?~ metadata `state
abet:check:(abed:handle-update:ha rid nodes u.group module.u.metadata)
=/ metadatum=(unit metadatum:metadata)
(peek-metadatum:met %graph rid)
?~ metadatum `state
abet:check:(abed:handle-update:ha rid nodes u.group module.u.metadatum)
--
::
++ on-peek on-peek:def
@ -300,7 +300,7 @@
--
::
|_ =bowl:gall
+* met ~(. metadata bowl)
+* met ~(. mdl bowl)
grp ~(. grouplib bowl)
gra ~(. graph bowl)
::
@ -344,7 +344,7 @@
|= rid=resource
^- ?
=/ group-rid=(unit resource)
(group-from-app-resource:met %graph rid)
(peek-group:met %graph rid)
?~ group-rid %.n
?| !(is-managed:grp u.group-rid)
&(watch-on-self =(our.bowl entity.rid))

View File

@ -1,7 +1,7 @@
:: hark-group-hook: notifications for groups [landscape]
::
/- store=hark-store, post, group-store, metadata-store, hook=hark-group-hook
/+ resource, metadata, default-agent, dbug, graph-store
/- store=hark-store, post, group-store, metadata=metadata-store, hook=hark-group-hook
/+ resource, mdl=metadata, default-agent, dbug, graph-store
::
~% %hark-group-hook-top ..part ~
|%
@ -28,7 +28,7 @@
+* this .
ha ~(. +> bowl)
def ~(. (default-agent this %|) bowl)
met ~(. metadata bowl)
met ~(. mdl bowl)
::
++ on-init
:_ this
@ -115,7 +115,7 @@
::
%metadata-update
=^ cards state
(metadata-update !<(metadata-update:metadata-store q.cage.sign))
(metadata-update !<(update:metadata q.cage.sign))
[cards this]
==
==
@ -140,7 +140,7 @@
:: - We have no way of retrieving old metadata to e.g. get a
:: channel's old name when it is renamed
++ metadata-update
|= update=metadata-update:metadata-store
|= =update:metadata
^- (quip card _state)
[~ state]
::

View File

@ -22,6 +22,7 @@
state:state-one:store
state-2
state-3
state-4
==
+$ unread-stats
[indices=(set index:graph-store) last=@da]
@ -37,13 +38,16 @@
==
::
+$ state-2
[%2 base-state]
[%2 state-two:store]
::
+$ state-3
[%3 base-state]
[%3 state-two:store]
::
+$ state-4
[%4 base-state]
::
+$ inflated-state
$: state-3
$: state-4
cache
==
:: $cache: useful to have precalculated, but can be derived from state
@ -84,9 +88,16 @@
=| cards=(list card)
|^
?- -.old
%3
%4
:- (flop cards)
this(-.state old, +.state (inflate-cache:ha old))
::
%3
%_ $
-.old %4
notifications.old (convert-notifications-3 notifications.old)
archive.old (convert-notifications-3 archive.old)
==
::
%2
%_ $
@ -96,7 +107,6 @@
:_ cards
[%pass / %agent [our dap]:bowl %poke noun+!>(%fix-dangling)]
==
::
%1
%_ $
@ -125,7 +135,55 @@
==
==
==
:: discard publish edits
::
++ convert-notifications-3
|= old=notifications:state-two:store
%+ gas:orm *notifications:store
^- (list [@da timebox:store])
%+ murn
(tap:orm:state-two:store old)
|= [time=@da =timebox:state-two:store]
^- (unit [@da timebox:store])
=/ new-timebox=timebox:store
(convert-timebox-3 timebox)
?: =(0 ~(wyt by new-timebox))
~
`[time new-timebox]
::
++ convert-timebox-3
|= =timebox:state-two:store
^- timebox:store
%- ~(gas by *timebox:store)
^- (list [index:store notification:store])
%+ murn
~(tap by timebox)
|= [=index:store =notification:state-two:store]
^- (unit [index:store notification:store])
=/ new-notification=(unit notification:store)
(convert-notification-3 notification)
?~ new-notification ~
`[index u.new-notification]
::
++ convert-notification-3
|= =notification:state-two:store
^- (unit notification:store)
?: ?=(%graph -.contents.notification)
`notification
=/ con=(list group-contents:store)
(convert-group-contents-3 list.contents.notification)
?: =(~ con) ~
=, notification
`[date read %group con]
::
++ convert-group-contents-3
|= con=(list group-contents:state-two:store)
^- (list group-contents:store)
%+ murn con
|= =group-contents:state-two:store
^- (unit group-contents:store)
?. ?=(?(%add-members %remove-members) -.group-contents) ~
`group-contents
::
++ uni-by
|= [a=(set index:graph-store) b=(set index:graph-store)]
=/ merged
@ -149,13 +207,13 @@
::
++ convert-notifications-1
|= old=notifications:state-zero:store
%+ gas:orm *notifications:store
^- (list [@da timebox:store])
%+ gas:orm:state-two:store *notifications:state-two:store
^- (list [@da timebox:state-two:store])
%+ murn
(tap:orm:state-zero:store old)
|= [time=@da =timebox:state-zero:store]
^- (unit [@da timebox:store])
=/ new-timebox=timebox:store
^- (unit [@da timebox:state-two:store])
=/ new-timebox=timebox:state-two:store
(convert-timebox-1 timebox)
?: =(0 ~(wyt by new-timebox))
~
@ -163,21 +221,20 @@
::
++ convert-timebox-1
|= =timebox:state-zero:store
^- timebox:store
%- ~(gas by *timebox:store)
^- (list [index:store notification:store])
^- timebox:state-two:store
%- ~(gas by *timebox:state-two:store)
^- (list [index:store notification:state-two:store])
%+ murn
~(tap by timebox)
|= [=index:state-zero:store =notification:state-zero:store]
^- (unit [index:store notification:store])
^- (unit [index:store notification:state-two:store])
=/ new-index=(unit index:store)
(convert-index-1 index)
=/ new-notification=(unit notification:store)
=/ new-notification=(unit notification:state-two:store)
(convert-notification-1 notification)
?~ new-index ~
?~ new-notification ~
`[u.new-index u.new-notification]
::
++ convert-index-1
|= =index:state-zero:store
@ -192,7 +249,7 @@
::
++ convert-notification-1
|= =notification:state-zero:store
^- (unit notification:store)
^- (unit notification:state-two:store)
?: ?=(%chat -.contents.notification)
~
`notification
@ -359,7 +416,7 @@
::
++ translate
^+ poke-core
?+ -.in poke-core
?- -.in
::
%add-note (add-note +.in)
%archive (do-archive +.in)
@ -377,6 +434,8 @@
%remove-graph (remove-graph +.in)
%set-dnd (set-dnd +.in)
%seen seen
%read-all read-all
::
==
::
:: +| %note
@ -597,6 +656,14 @@
=> (emit autoseen-timer)
poke-core(current-timebox now.bowl)
::
++ read-all
=: unreads-count (~(run by unreads-count) _0)
unreads-each (~(run by unreads-each) _~)
notifications (~(run by notifications) _~)
==
=> rebuild-cache
seen
::
++ set-dnd
|= d=?
(give:poke-core(dnd d) %set-dnd d)
@ -683,7 +750,7 @@
==
::
++ inflate-cache
|= state-3
|= state-4
^+ +.state
=/ nots=(list [p=@da =timebox:store])
(tap:orm notifications)

View File

@ -2,7 +2,7 @@
/+ drum=hood-drum, helm=hood-helm, kiln=hood-kiln
|%
+$ state
$: %11
$: %12
drum=state:drum
helm=state:helm
kiln=state:kiln
@ -14,6 +14,7 @@
[%8 drum=state:drum helm=state:helm kiln=state:kiln]
[%9 drum=state:drum helm=state:helm kiln=state:kiln]
[%10 drum=state:drum helm=state:helm kiln=state:kiln]
[%11 drum=state:drum helm=state:helm kiln=state:kiln]
==
+$ any-state-tuple
$: drum=any-state:drum

View File

@ -6,6 +6,7 @@
+$ versioned-state
$% state-0
state-1
state-2
==
::
+$ invitatory-0 (map serial:store invite-0)
@ -19,9 +20,10 @@
::
+$ state-0 [%0 invites=(map path invitatory-0)]
+$ state-1 [%1 =invites:store]
+$ state-2 [%2 =invites:store]
--
::
=| state-1
=| state-2
=* state -
%- agent:dbug
^- agent:gall
@ -36,44 +38,31 @@
%_ this
invites.state
%- ~(gas by *invites:store)
[%graph *invitatory:store]~
:~ [%graph *invitatory:store]
[%groups *invitatory:store]
==
==
::
++ on-save !>(state)
++ on-load
|= old-vase=vase
=/ old !<(versioned-state old-vase)
=| cards=(list card)
|-
?: ?=(%2 -.old)
[cards this(state old)]
?: ?=(%1 -.old)
`this(state old)
:- =- [%pass / %agent [our.bowl %invite-store] %poke %invite-action -]~
!> ^- action:store
[%create %graph]
%= this
state
:- %1
%- ~(gas by *invites:store)
%+ murn ~(tap by invites.old)
|= [=path =invitatory-0]
^- (unit [term invitatory:store])
?. ?=([@ ~] path) ~
:- ~
:- i.path
%- ~(gas by *invitatory:store)
%+ murn ~(tap by invitatory-0)
|= [=serial:store =invite-0]
^- (unit [serial:store invite:store])
=/ resource=(unit resource:res) (de-path-soft:res path.invite-0)
?~ resource ~
:- ~
:- serial
^- invite:store
:* ship.invite-0
app.invite-0
u.resource
recipient.invite-0
text.invite-0
==
==
=. cards
:~ =- [%pass / %agent [our.bowl %invite-store] %poke %invite-action -]
!> ^- action:store
[%create %groups]
::
=- [%pass / %agent [our.bowl %invite-store] %poke %invite-action -]
!> ^- action:store
[%delete %contacts]
==
$(-.old %2)
$(old [%1 (~(gas by *invites:store) [%graph *invitatory:store]~)])
::
++ on-agent on-agent:def
++ on-arvo on-arvo:def
@ -109,11 +98,19 @@
++ poke-import
|= arc=*
^- (quip card _state)
=/ sty=state-1
:- %1
=/ sty=state-2
:- %2
%- remake-map-of-map
;;((tree [term (tree [serial:store invite:store])]) +.arc)
[~ sty]
:_ sty
:~ =- [%pass / %agent [our.bowl %invite-store] %poke %invite-action -]
!> ^- action:store
[%create %groups]
::
=- [%pass / %agent [our.bowl %invite-store] %poke %invite-action -]
!> ^- action:store
[%delete %contacts]
==
::
++ poke-invite-action
|= =action:store

File diff suppressed because one or more lines are too long

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

View File

@ -24,6 +24,6 @@
<div id="portal-root"></div>
<script src="/~landscape/js/channel.js"></script>
<script src="/~landscape/js/session.js"></script>
<script src="/~landscape/js/bundle/index.c5df4039d68847ffe61c.js"></script>
<script src="/~landscape/js/bundle/index.6c6f14401abf27359ea5.js"></script>
</body>
</html>

View File

@ -25,7 +25,6 @@
^- (list @tas)
:~ %group-store
%metadata-store
%metadata-hook
%contact-store
%contact-hook
%invite-store

View File

@ -6,315 +6,75 @@
:: /group/%group-path all updates related to this group
::
/- *metadata-store, *metadata-hook
/+ default-agent, dbug, verb, grpl=group, *migrate
/+ default-agent, dbug, verb, grpl=group, *migrate, resource
~% %metadata-hook-top ..part ~
|%
+$ card card:agent:gall
+$ versioned-state
$% state-zero
state-one
state-two
==
::
+$ state-zero
$: %0
synced=(map group-path ship)
synced=(map path ship)
==
+$ state-one
$: %1
synced=(map group-path ship)
synced=(map path ship)
==
+$ state-two
[%2 ~]
--
=| state-one
=| state-two
=* state -
%- agent:dbug
%+ verb |
^- agent:gall
=<
|_ =bowl:gall
+* this .
hc ~(. +> bowl)
def ~(. (default-agent this %|) bowl)
::
++ on-init
[[%pass /updates %agent [our.bowl %metadata-store] %watch /updates]~ this]
::
++ on-save !>(state)
++ on-load
|= =vase
=/ old
!<(versioned-state vase)
?: ?=(%1 -.old)
`this(state old)
:: groups OTA did not migrate metadata syncs
:: we clear our syncs, and wait for metadata-store
:: to poke us with the syncs
`this
::
++ on-leave on-leave:def
++ on-peek
|= =path
^- (unit (unit cage))
?+ path (on-peek:def path)
[%x %export ~]
``noun+!>(state)
==
::
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card _this)
?. ?=([%try-rejoin @ @ *] wire)
(on-arvo:def wire sign-arvo)
=/ nack-count=@ud (slav %ud i.t.wire)
=/ who=@p (slav %p i.t.t.wire)
=/ pax t.t.t.wire
?> ?=([%behn %wake *] sign-arvo)
~? ?=(^ error.sign-arvo)
"behn errored in backoff timers, continuing anyway"
:_ this
[(try-rejoin:hc who pax +(nack-count))]~
::
++ on-fail on-fail:def
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
?+ mark (on-poke:def mark vase)
%metadata-hook-action
=^ cards state
(poke-hook-action:hc !<(metadata-hook-action vase))
[cards this]
::
%metadata-action
[(poke-action:hc !<(metadata-action vase)) this]
::
%import
?> (team:title our.bowl src.bowl)
=^ cards state
(poke-import:hc q.vase)
[cards this]
==
::
++ on-watch
|= =path
^- (quip card _this)
?+ path (on-watch:def path)
[%group *] [(watch-group:hc t.path) this]
==
::
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
?+ -.sign (on-agent:def wire sign)
%kick =^(cards state (kick:hc wire) [cards this])
%watch-ack =^(cards state (watch-ack:hc wire p.sign) [cards this])
%fact
?+ p.cage.sign (on-agent:def wire sign)
%metadata-update
=^ cards state
(fact-metadata-update:hc wire !<(metadata-update q.cage.sign))
[cards this]
==
==
--
::
|_ =bowl:gall
+* grp ~(. grpl bowl)
++ poke-hook-action
|= act=metadata-hook-action
^- (quip card _state)
+* this .
def ~(. (default-agent *agent:gall %|) bowl)
++ on-init on-init:def
++ on-save !>(state)
++ on-load
|= =vase
=+ !<(old=versioned-state vase)
|^
?- -.act
%add-owned
?> (team:title our.bowl src.bowl)
:- ~
?: (~(has by synced) path.act) state
state(synced (~(put by synced) path.act our.bowl))
?: ?=(%2 -.old)
`this
:_ this
%+ murn
~(tap by synced.old)
|= [group=path =ship]
%+ bind
(de-path-soft:resource group)
|= rid=resource
?: =(our.bowl ship)
(push-metadata rid)
(pull-metadata rid ship)
::
%add-synced
?> (team:title our.bowl src.bowl)
=/ =path [%group path.act]
?: (~(has by synced) path.act) [~ state]
:_ state(synced (~(put by synced) path.act ship.act))
[%pass path %agent [ship.act %metadata-hook] %watch path]~
++ poke-our
|= [app=term =cage]
^- card
[%pass / %agent [our.bowl app] %poke cage]
::
%remove
=/ ship (~(get by synced) path.act)
?~ ship [~ state]
?: &(!=(u.ship src.bowl) ?!((team:title our.bowl src.bowl)))
[~ state]
:_ state(synced (~(del by synced) path.act))
%- zing
:~ (unsubscribe [%group path.act] u.ship)
[%give %kick ~[[%group path.act]] ~]~
==
==
++ push-metadata
|= rid=resource
^- card
(poke-our %metadata-push-hook push-hook-action+!>([%add rid]))
::
++ unsubscribe
|= [=path =ship]
^- (list card)
?: =(ship our.bowl)
[%pass path %agent [our.bowl %metadata-store] %leave ~]~
[%pass path %agent [ship %metadata-hook] %leave ~]~
++ pull-metadata
|= [rid=resource =ship]
^- card
(poke-our %metadata-pull-hook pull-hook-action+!>([%add ship rid]))
--
::
++ poke-action
|= act=metadata-action
^- (list card)
|^
?: (team:title our.bowl src.bowl)
?- -.act
%add (send group-path.act)
%remove (send group-path.act)
==
?> (is-member:grp src.bowl group-path.act)
?- -.act
%add (metadata-poke our.bowl %metadata-store)
%remove (metadata-poke our.bowl %metadata-store)
==
::
++ send
|= =group-path
^- (list card)
=/ =ship
%+ slav %p
(snag 1 group-path)
=/ app ?:(=(ship our.bowl) %metadata-store %metadata-hook)
(metadata-poke ship app)
::
++ metadata-poke
|= [=ship app=@tas]
^- (list card)
[%pass / %agent [ship app] %poke %metadata-action !>(act)]~
::
++ is-managed
|= =path
^- ?
?> ?=(^ path)
!=(i.path '~')
--
::
++ poke-import
|= arc=*
^- (quip card _state)
=/ sty=state-one
[%1 (remake-map ;;((tree [group-path ship]) +.arc))]
:_ sty
%+ murn ~(tap by synced.sty)
|= [=group-path =ship]
?: =(ship our.bowl)
~
=/ =path [%group group-path]
`(try-rejoin ship path 0)
::
++ try-rejoin
|= [who=@p pax=path nack-count=@ud]
^- card
=/ =wire
[%try-rejoin (scot %ud nack-count) (scot %p who) pax]
[%pass wire %agent [who %metadata-hook] %watch pax]
::
++ watch-group
|= =path
^- (list card)
|^
?> =(our.bowl (~(got by synced) path))
?> (is-member:grp src.bowl path)
%+ turn ~(tap by (metadata-scry path))
|= [[=group-path =md-resource] =metadata]
^- card
[%give %fact ~ %metadata-update !>([%add group-path md-resource metadata])]
::
++ metadata-scry
|= pax=^path
^- associations
=. pax
;: weld
/(scot %p our.bowl)/metadata-store/(scot %da now.bowl)/group
pax
/noun
==
.^(associations %gx pax)
--
::
++ fact-metadata-update
|= [wir=wire fact=metadata-update]
^- (quip card _state)
|^
[?:((team:title our.bowl src.bowl) handle-local handle-foreign) state]
::
++ handle-local
?+ -.fact ~
%add
?. (~(has by synced) group-path.fact) ~
(give group-path.fact fact)
::
%update-metadata
?. (~(has by synced) group-path.fact) ~
(give group-path.fact fact)
::
%remove
?. (~(has by synced) group-path.fact) ~
(give group-path.fact fact)
==
::
++ handle-foreign
?+ -.fact ~
%add
?. =(src.bowl (~(got by synced) group-path.fact)) ~
(poke fact)
::
%update-metadata
?. =(src.bowl (~(got by synced) group-path.fact)) ~
(poke [%add +.fact])
::
%remove
?. =(src.bowl (~(got by synced) group-path.fact)) ~
(poke fact)
==
::
++ give
|= [=path upd=metadata-update]
^- (list card)
[%give %fact ~[[%group path]] %metadata-update !>(upd)]~
::
++ poke
|= act=metadata-action
^- (list card)
[%pass / %agent [our.bowl %metadata-store] %poke %metadata-action !>(act)]~
--
::
++ kick
|= wir=wire
^- (quip card _state)
:_ state
|-
?+ wir !!
[%try-rejoin @ @ *]
$(wir t.t.t.wir)
::
[%updates ~]
[%pass /updates %agent [our.bowl %metadata-store] %watch /updates]~
::
[%group @ *]
?. (~(has by synced) t.wir) ~
=/ =ship (~(got by synced) t.wir)
?: =(ship our.bowl)
[%pass wir %agent [our.bowl %metadata-store] %watch wir]~
[%pass wir %agent [ship %metadata-hook] %watch wir]~
==
::
++ watch-ack
|= [wir=wire saw=(unit tang)]
^- (quip card _state)
?: ?=([%try-rejoin @ *] wir)
?~ saw
[~ state]
=/ nack-count=@ud (slav %ud i.t.wir)
=/ wakeup=@da
(add now.bowl (mul ~s1 (bex (min 19 nack-count))))
:_ state
[%pass wir %arvo %b %wait wakeup]~
?> ?=(^ wir)
[~ ?~(saw state state(synced (~(del by synced) t.wir)))]
::
++ on-poke on-poke:def
++ on-watch on-watch:def
++ on-peek on-peek:def
++ on-leave on-leave:def
++ on-agent on-agent:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
--

View File

@ -0,0 +1,213 @@
:: metadata-pull-hook [landscape]:
::
:: allow syncing group data from foreign paths to local paths
::
/- *group, invite-store, metadata=metadata-store, contact=contact-store
/+ default-agent, verb, dbug, store=group-store, grpl=group, pull-hook
/+ resource, mdl=metadata, agn=agentio
~% %group-hook-top ..part ~
|%
+$ card card:agent:gall
::
++ config
^- config:pull-hook
:* %metadata-store
update:metadata
%metadata-update
%metadata-push-hook
%.n
==
+$ state-zero
[%0 previews=(map resource group-preview:metadata)]
::
--
::
::
%- agent:dbug
%+ verb |
^- agent:gall
%- (agent:pull-hook config)
^- (pull-hook:pull-hook config)
=| state-zero
=* state -
=> |_ =bowl:gall
++ def ~(. (default-agent state %|) bowl)
++ met ~(. mdl bowl)
++ io ~(. agn bowl)
++ get-preview
|= rid=resource
=/ =path
preview+(en-path:resource rid)
=/ =dock
[entity.rid %metadata-push-hook]
%+ ~(poke pass:io path) dock
metadata-hook-update+!>([%req-preview rid])
::
++ watch-invites
(~(watch-our pass:io /invites) %invite-store /updates)
::
++ take-invites
|= =sign:agent:gall
^- (quip card _state)
?+ -.sign (on-agent:def /invites sign)
%fact
?> ?=(%invite-update p.cage.sign)
=+ !<(=update:invite-store q.cage.sign)
:_ state
?. ?=(%invite -.update) ~
(get-preview resource.invite.update)^~
::
%kick [watch-invites^~ state]
==
::
++ watch-contacts
(~(watch-our pass:io /contacts) %contact-store /all)
::
++ take-contacts
|= =sign:agent:gall
^- (quip card _state)
?+ -.sign (on-agent:def /contacts sign)
%kick [~[watch-contacts] state]
::
%fact
:_ state
?> ?=(%contact-update p.cage.sign)
=+ !<(=update:contact q.cage.sign)
?+ -.update ~
%add
(check-contact contact.update)
::
%edit
?. ?=(%add-group -.edit-field.update) ~
%- add-missing-previews
(~(gas in *(set resource)) resource.edit-field.update ~)
::
%initial
^- (list card)
%- zing
%+ turn ~(tap by rolodex.update)
|=([ship =contact:contact] (check-contact contact))
==
==
::
++ check-contact
|= =contact:contact
^- (list card)
(add-missing-previews groups.contact)
::
++ add-missing-previews
|= groups=(set resource)
^- (list card)
=/ missing=(set resource)
(~(dif in ~(key by previews)) groups)
%+ murn ~(tap by missing)
|= group=resource
^- (unit card)
?^ (peek-metadatum:met %groups group) ~
`(get-preview group)
::
++ watch-store
(~(watch-our pass:io /store) %metadata-store /all)
::
++ take-store
|= =sign:agent:gall
^- (quip card _state)
?+ -.sign (on-agent:def /store sign)
%kick [watch-store^~ state]
::
%fact
?> ?=(%metadata-update p.cage.sign)
=+ !<(=update:metadata q.cage.sign)
?. ?=(%initial-group -.update) `state
`state(previews (~(del by previews) group.update))
==
--
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
dep ~(. (default:pull-hook this config) bowl)
met ~(. mdl bowl)
hc ~(. +> bowl)
::
++ on-init
:_ this
:~ watch-invites:hc
watch-contacts:hc
watch-store:hc
==
::
++ on-save !>(state)
++ on-load
|= =vase
=+ !<(old=state-zero vase)
`this(state old)
::
++ on-poke
|= [=mark =vase]
?. ?=(%metadata-hook-update mark)
(on-poke:def mark vase)
=+ !<(=hook-update:metadata vase)
?. ?=(%preview -.hook-update)
(on-poke:def mark vase)
:_ this(previews (~(put by previews) group.hook-update +.hook-update))
=/ =path
preview+(en-path:resource group.hook-update)
(fact-kick:io path mark^vase)
::
++ on-agent
|= [=wire =sign:agent:gall]
=^ cards state
?+ wire (on-agent:def:hc wire sign)
[%invites ~] (take-invites:hc sign)
[%contacts ~] (take-contacts:hc sign)
[%store ~] (take-store:hc sign)
::
[%preview @ @ @ ~]
?. ?=(%poke-ack -.sign)
(on-agent:def:hc wire sign)
:_ state
?~ p.sign ~
(fact-kick:io wire tang+!>(u.p.sign))
==
[cards this]
::
++ on-watch
|= =path
?> (team:title [our src]:bowl)
?. ?=([%preview @ @ @ ~] path)
(on-watch:def path)
=/ rid=resource
(de-path:resource t.path)
=/ prev=(unit group-preview:metadata)
?^ (peek-metadatum:met %groups rid)
(some (get-preview:met rid))
(~(get by previews) rid)
:_ this
?~ prev
(get-preview rid)^~
(fact-init:io metadata-hook-update+!>([%preview u.prev]))^~
::
++ on-leave on-leave:def
++ on-peek on-peek:def
++ on-arvo on-arvo:def
::
++ on-fail on-fail:def
++ resource-for-update resource-for-update:met
++ on-pull-nack
|= [=resource =tang]
^- (quip card _this)
=/ =associations:metadata
(metadata-for-group:met resource)
:_ this
%+ turn ~(tap by associations)
|= [=md-resource:metadata =association:metadata]
%+ poke-our:pass:io %metadata-store
:- %metadata-update
!> ^- update:metadata
[%remove resource md-resource]
::
++ on-pull-kick
|= =resource
^- (unit path)
`/
--

View File

@ -0,0 +1,94 @@
:: metadata-push-hook [landscape]:
::
/- *group, *invite-store, store=metadata-store
/+ default-agent, verb, dbug, grpl=group, push-hook,
resource, mdl=metadata, gral=graph
~% %group-hook-top ..part ~
|%
+$ card card:agent:gall
::
++ config
^- config:push-hook
:* %metadata-store
/all
update:store
%metadata-update
%metadata-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)
met ~(. mdl bowl)
gra ~(. gral bowl)
::
++ on-init on-init:def
++ on-save !>(~)
++ on-load on-load:def
++ on-poke
|= [=mark =vase]
?. ?=(%metadata-hook-update mark)
(on-poke:def mark vase)
=+ !<(=hook-update:store vase)
?. ?=(%req-preview -.hook-update)
(on-poke:def mark vase)
?> =(entity.group.hook-update our.bowl)
=/ =group-preview:store
(get-preview:met group.hook-update)
:_ this
=- [%pass / %agent [src.bowl %metadata-pull-hook] %poke -]~
metadata-hook-update+!>(`hook-update:store`[%preview group-preview])
::
++ 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 vase)
?. ?=(?(%add %remove) -.update)
%.n
=/ role=(unit (unit role-tag))
(role-for-ship:grp group.update src.bowl)
=/ =metadatum:store
(need (peek-metadatum:met %contacts group.update))
?~ role %.n
?^ u.role
?=(?(%admin %moderator) u.u.role)
?. ?=(%add -.update) %.n
?& =(src.bowl entity.resource.resource.update)
?=(%member-metadata vip.metadatum)
==
::
++ resource-for-update resource-for-update:met
++ take-update
|= =vase
^- [(list card) agent]
`this
::
++ initial-watch
|= [=path rid=resource]
^- vase
=/ group
(scry-group:grp rid)
=/ =associations:store
(metadata-for-group:met rid)
?> ?=(^ group)
?> (~(has in members.u.group) src.bowl)
!> ^- update:store
[%initial-group rid associations]
::
--

View File

@ -3,11 +3,11 @@
:: data store for application metadata and mappings
:: between groups and resources within applications
::
:: group-paths are expected to be an existing group path
:: paths are expected to be an existing group path
:: resources are expected to correspond to existing app paths
::
:: note: when scrying for metadata, to make the arguments safe in paths,
:: encode group-path and app-path using (scot %t (spat group-path))
:: encode path and path using (scot %t (spat path))
::
:: +watch paths:
:: /all associations + updates
@ -19,22 +19,22 @@
:: /group-indices all group indices
:: /app-indices all app indices
:: /resource-indices all resource indices
:: /metadata/%group-path/%app-name/%app-path specific metadatum
:: /metadata/%path/%app-name/%path specific metadatum
:: /app-name/%app-name associations for app
:: /group/%group-path associations for group
:: /group/%path associations for group
::
/- *metadata-store, *metadata-hook
/+ *metadata-json, default-agent, verb, dbug, resource, *migrate
/- store=metadata-store
/+ default-agent, verb, dbug, resource, *migrate
|%
+$ card card:agent:gall
+$ base-state-0
$: associations=associations-0
group-indices=(jug group-path md-resource)
app-indices=(jug app-name [group-path app-path])
resource-indices=(jug md-resource group-path)
group-indices=(jug path md-resource:store)
app-indices=(jug app-name:store [path path])
resource-indices=(jug md-resource:store path)
==
::
+$ associations-0 (map [group-path md-resource] metadata-0)
+$ associations-0 (map [path md-resource:store] metadata-0)
::
+$ metadata-0
$: title=@t
@ -44,11 +44,35 @@
creator=@p
==
::
+$ metadata-1
$: title=@t
description=@t
color=@ux
date-created=@da
creator=@p
module=term
==
::
+$ md-resource-1 [=app-name:store =path]
::
+$ associations-1 (map [path md-resource-1] metadata-1)
::
+$ base-state-1
$: associations=associations
group-indices=(jug group-path md-resource)
app-indices=(jug app-name [group-path app-path])
resource-indices=(jug md-resource group-path)
$: associations=associations-1
group-indices=(jug path md-resource-1)
app-indices=(jug app-name:store [path path])
resource-indices=(jug md-resource-1 path)
==
::
+$ cached-indices
$: group-indices=(jug resource md-resource:store)
app-indices=(jug app-name:store [group=resource =resource])
resource-indices=(map md-resource:store resource)
==
::
+$ base-state-2
$: =associations:store
~
==
::
+$ state-0 [%0 base-state-0]
@ -58,6 +82,7 @@
+$ state-4 [%4 base-state-1]
+$ state-5 [%5 base-state-1]
+$ state-6 [%6 base-state-1]
+$ state-7 [%7 base-state-2]
+$ versioned-state
$% state-0
state-1
@ -66,10 +91,16 @@
state-4
state-5
state-6
state-7
==
::
+$ inflated-state
$: state-7
cached-indices
==
--
::
=| state-6
=| inflated-state
=* state -
%+ verb |
%- agent:dbug
@ -81,7 +112,7 @@
def ~(. (default-agent this %|) bowl)
::
++ on-init on-init:def
++ on-save !>(state)
++ on-save !>(-.state)
++ on-load
|= =vase
^- (quip card _this)
@ -95,30 +126,13 @@
?> (team:title our.bowl src.bowl)
=^ cards state
?+ mark (on-poke:def mark vase)
%metadata-action
(poke-metadata-action:mc !<(metadata-action vase))
::
%noun
=/ val=(each [%cleanup path] tang)
(mule |.(!<([%cleanup path] vase)))
?. ?=(%& -.val)
(on-poke:def mark vase)
=/ group=path +.p.val
=/ res=(set md-resource) (~(get ju group-indices) group)
=. group-indices (~(del by group-indices) group)
:- ~
%+ roll ~(tap in res)
|= [r=md-resource out=_state]
=: resource-indices.out (~(del by resource-indices.out) r)
associations.out (~(del by associations.out) group r)
app-indices.out
%- ~(del ju app-indices.out)
[app-name.r group app-path.r]
==
out
?(%metadata-action %metadata-update)
(poke-metadata-update:mc !<(update:store vase))
::
%import
(poke-import:mc q.vase)
::
%noun ~& +.state `state
==
[cards this]
::
@ -136,7 +150,7 @@
~
::
[%app-name @ ~]
=/ =app-name i.t.path
=/ =app-name:store i.t.path
=/ app-indices (metadata-for-app:mc app-name)
(give %metadata-update !>([%associations app-indices]))
==
@ -157,25 +171,26 @@
[%y %resource-indices ~] ``noun+!>(resource-indices)
[%x %associations ~] ``noun+!>(associations)
[%x %app-name @ ~]
=/ =app-name i.t.t.path
=/ =app-name:store i.t.t.path
``noun+!>((metadata-for-app:mc app-name))
::
[%x %group *]
=/ =group-path t.t.path
``noun+!>((metadata-for-group:mc group-path))
=/ group=resource (de-path:resource t.t.path)
``noun+!>((metadata-for-group:mc group))
::
[%x %metadata @ @ @ ~]
=/ =group-path (stab (slav %t i.t.t.path))
=/ =md-resource [`term`i.t.t.t.path (stab (slav %t i.t.t.t.t.path))]
``noun+!>((~(get by associations) [group-path md-resource]))
[%x %metadata @ @ @ @ ~]
=/ =md-resource:store
[i.t.t.path (de-path:resource t.t.t.path)]
``noun+!>((~(get by associations) md-resource))
::
[%x %resource @ *]
=/ app=term i.t.t.path
=/ app-path=^path t.t.t.path
``noun+!>((~(get by resource-indices) app app-path))
=/ rid=resource (de-path:resource t.t.t.path)
``noun+!>((~(get by resource-indices) [app rid]))
::
[%x %export ~]
``noun+!>(state)
``noun+!>(-.state)
==
::
++ on-leave on-leave:def
@ -192,307 +207,242 @@
=/ old !<(versioned-state vase)
=| cards=(list card)
|^
?: ?=(%6 -.old)
=/ =^associations
(migrate-app-to-graph-store %chat associations.old)
=* loop $
?: ?=(%7 -.old)
:- cards
%_ state
associations associations
::
resource-indices
(rebuild-resource-indices associations)
%_ state
associations
associations.old
::
resource-indices
(rebuild-resource-indices associations.old)
::
group-indices
(rebuild-group-indices associations.old)
::
app-indices
(rebuild-app-indices associations)
::
group-indices
(rebuild-group-indices associations)
(rebuild-app-indices associations.old)
==
?: ?=(%6 -.old)
=/ old-assoc=associations-1
(migrate-app-to-graph-store %chat associations.old)
$(old [%7 (associations-1-to-2 old-assoc) ~])
::
?: ?=(%5 -.old)
=/ =^associations
=/ associations=associations-1
(migrate-app-to-graph-store %publish associations.old)
%_ $
-.old %6
associations.old associations
::
resource-indices.old
(rebuild-resource-indices associations)
::
app-indices.old
(rebuild-app-indices associations)
::
group-indices.old
(rebuild-group-indices associations)
==
?: ?=(%4 -.old)
%_ $
-.old %5
::
resource-indices.old
(rebuild-resource-indices associations.old)
::
app-indices.old
(rebuild-app-indices associations.old)
::
group-indices.old
(rebuild-group-indices associations.old)
:: pre-breach, can safely throw away
loop(old *state-7)
::
++ associations-1-to-2
|= assoc=associations-1
^- associations:store
%- ~(gas by *associations:store)
%+ murn
~(tap by assoc)
|= [[group=path m=md-resource-1] met=metadata-1]
%+ biff (de-path-soft:resource group)
|= g=resource
%+ bind (md-resource-1-to-2 m)
|= =md-resource:store
[md-resource g (metadata-1-to-2 met)]
::
++ md-resource-1-to-2
|= m=md-resource-1
^- (unit md-resource:store)
%+ bind (de-path-soft:resource path.m)
|= rid=resource
:_ rid
?: =(%contacts app-name.m) %groups
app-name.m
::
++ metadata-1-to-2
|= m=metadata-1
%* . *metadatum:store
title title.m
description description.m
color color.m
date-created date-created.m
creator creator.m
module module.m
preview %.n
==
?: ?=(%3 -.old)
$(old [%4 +.old])
?: ?=(%2 -.old)
=/ new-state=state-3
%* . *state-3
associations
%- malt
%+ murn ~(tap by associations.old)
|= [[=group-path =md-resource] m=metadata-0]
^- (unit [[^group-path ^md-resource] metadata])
?: =(app-name.md-resource %link) ~
`[[group-path md-resource] (old-md-to-new m)]
==
$(old new-state)
?: ?=(%1 -.old)
%_ $
old [%2 +.old]
::
cards
%+ murn ~(tap in ~(key by group-indices.old))
|= =group-path
^- (unit card)
=/ rid (de-path-soft:resource group-path)
?~ rid ~
?: =(our.bowl entity.u.rid)
`(poke-md-hook %add-owned group-path)
`(poke-md-hook %add-synced entity.u.rid group-path)
==
=/ new-state-1=state-1
%* . *state-1
associations (migrate-associations associations.old)
group-indices (migrate-group-indices group-indices.old)
app-indices (migrate-app-indices app-indices.old)
resource-indices (migrate-resource-indices resource-indices.old)
==
$(old new-state-1)
::
++ rebuild-resource-indices
|= =^associations
%- ~(gas ju *(jug md-resource group-path))
%+ turn ~(tap in ~(key by associations))
|= [g=group-path r=md-resource]
^- [md-resource group-path]
|= =associations:store
%- ~(gas by *(map md-resource:store resource))
%+ turn ~(tap by associations)
|= [r=md-resource:store g=resource =metadatum:store]
[r g]
::
++ rebuild-group-indices
|= =^associations
%- ~(gas ju *(jug group-path md-resource))
~(tap in ~(key by associations))
|= =associations:store
%- ~(gas ju *(jug resource md-resource:store))
%+ turn
~(tap by associations)
|= [r=md-resource:store g=resource =metadatum:store]
[g r]
::
++ rebuild-app-indices
|= =^associations
%- ~(gas ju *(jug app-name [group-path app-path]))
%+ turn ~(tap in ~(key by associations))
|= [g=group-path r=md-resource]
^- [app-name [group-path app-path]]
[app-name.r [g app-path.r]]
|= =associations:store
%- ~(gas ju *(jug app-name:store [group=resource resource]))
%+ turn ~(tap by associations)
|= [r=md-resource:store g=resource =metadatum:store]
[app-name.r g resource.r]
::
++ migrate-app-to-graph-store
|= [app=@tas =^associations]
^+ associations
|= [app=@tas associations=associations-1]
^- associations-1
%- malt
%+ turn ~(tap by associations)
|= [[=group-path =md-resource] m=metadata]
^- [[^group-path ^md-resource] metadata]
|= [[=path md-resource=md-resource-1] m=metadata-1]
^- [[^path md-resource-1] metadata-1]
?. =(app-name.md-resource app)
[[group-path md-resource] m]
=/ new-app-path=path
?. ?=([@ @ ~] app-path.md-resource)
app-path.md-resource
ship+app-path.md-resource
[[group-path [%graph new-app-path]] m(module app)]
::
++ poke-md-hook
|= act=metadata-hook-action
^- card
=/ =cage metadata-hook-action+!>(act)
[%pass / %agent [our.bowl %metadata-hook] %poke cage]
::
++ new-group-path
|= =group-path
ship+(new-app-path group-path)
::
++ new-app-path
|= =app-path
^- path
?> ?=(^ app-path)
?:(=('~' i.app-path) t.app-path app-path)
::
++ old-md-to-new
|= m=metadata-0
^- metadata
%* . *metadata
title title.m
description description.m
color color.m
date-created date-created.m
creator creator.m
module *term
==
::
++ migrate-md-resource
|= md-resource
^- md-resource
?: =(%chat app-name) [%chat (new-app-path app-path)]
?: =(%contacts app-name) [%contacts ship+app-path]
[app-name app-path]
::
++ migrate-resource-indices
|= resource-indices=(jug md-resource group-path)
^- (jug md-resource group-path)
%- malt
%+ turn ~(tap by resource-indices)
|= [=md-resource paths=(set group-path)]
:- (migrate-md-resource md-resource)
(~(run in paths) new-group-path)
::
++ migrate-app-indices
|= app-indices=(jug app-name [group-path app-path])
%- malt
%+ turn ~(tap by app-indices)
|= [app=term indices=(set [=group-path =app-path])]
:- app
%- ~(run in indices)
|= [=group-path =app-path]
:- (new-group-path group-path)
?: =(%chat app) (new-app-path app-path)
?: =(%contacts app) ship+app-path
app-path
::
++ migrate-group-indices
|= group-indices=(jug group-path md-resource)
%- malt
%+ turn ~(tap by group-indices)
|= [=group-path resources=(set md-resource)]
:- (new-group-path group-path)
%- sy
%+ turn ~(tap in resources)
migrate-md-resource
::
++ migrate-associations
|= associations=associations-0
%- malt
%+ turn ~(tap by associations)
|= [[g=group-path r=md-resource] m=metadata-0]
:_ m
[(new-group-path g) (migrate-md-resource r)]
[[path md-resource] m]
=/ new-path=^path
?. ?=([@ @ ~] path.md-resource)
path.md-resource
ship+path.md-resource
[[path [%graph new-path]] m(module app)]
--
++ poke-metadata-action
|= act=metadata-action
++ poke-metadata-update
|= upd=update:store
^- (quip card _state)
?> (team:title our.bowl src.bowl)
?- -.act
%add (handle-add group-path.act resource.act metadata.act)
%remove (handle-remove group-path.act resource.act)
?> (team:title [our src]:bowl)
?+ -.upd !!
%add (handle-add +.upd)
%remove (handle-remove +.upd)
%initial-group (handle-initial-group +.upd)
==
::
++ poke-import
|= arc=*
^- (quip card _state)
|^
(on-load !>([%5 (remake-metadata ;;(tree-metadata +.arc))]))
=^ cards state
(on-load !>([%7 (remake-metadata ;;(tree-metadata +.arc))]))
:_ state
%+ weld cards
%+ turn ~(tap in ~(key by group-indices))
|= rid=resource
%- poke-our
?: =(entity.rid our.bowl)
:- %metadata-push-hook
push-hook-action+!>([%add rid])
:- %metadata-pull-hook
pull-hook-action+!>([%add [entity .]:rid])
::
++ poke-our
|= [app=term =cage]
^- card
[%pass / %agent [our.bowl app] %poke cage]
::
+$ tree-metadata
$: associations=(tree [[group-path md-resource] metadata])
group-indices=(tree [group-path (tree md-resource)])
app-indices=(tree [app-name (tree [group-path app-path])])
resource-indices=(tree [md-resource (tree group-path)])
$: associations=(tree [md-resource:store [resource metadatum:store]])
~
==
::
++ remake-metadata
|= tm=tree-metadata
^- base-state-1
^- base-state-2
:* (remake-map associations.tm)
(remake-jug group-indices.tm)
(remake-jug app-indices.tm)
(remake-jug resource-indices.tm)
~
==
--
::
++ handle-add
|= [=group-path =md-resource =metadata]
|= [group=resource =md-resource:store =metadatum:store]
^- (quip card _state)
:- %+ send-diff app-name.md-resource
?: (~(has by resource-indices) md-resource)
[%update-metadata group-path md-resource metadata]
[%add group-path md-resource metadata]
:- %- send-diff
[%add group md-resource metadatum]
%= state
associations
(~(put by associations) [group-path md-resource] metadata)
::
group-indices
(~(put ju group-indices) group-path md-resource)
(~(put by associations) md-resource [group metadatum])
::
app-indices
%+ ~(put ju app-indices)
app-name.md-resource
[group-path app-path.md-resource]
[group resource.md-resource]
::
resource-indices
(~(put ju resource-indices) md-resource group-path)
(~(put by resource-indices) md-resource group)
::
group-indices
(~(put ju group-indices) group md-resource)
==
::
++ handle-remove
|= [=group-path =md-resource]
|= [group=resource =md-resource:store]
^- (quip card _state)
:- (send-diff app-name.md-resource [%remove group-path md-resource])
:- (send-diff [%remove group md-resource])
%= state
associations
(~(del by associations) [group-path md-resource])
::
group-indices
(~(del ju group-indices) group-path md-resource)
(~(del by associations) md-resource)
::
app-indices
%+ ~(del ju app-indices)
app-name.md-resource
[group-path app-path.md-resource]
[group resource.md-resource]
::
resource-indices
(~(del ju resource-indices) md-resource group-path)
(~(del by resource-indices) md-resource)
::
group-indices
(~(del ju group-indices) group md-resource)
==
::
++ handle-initial-group
|= [group=resource =associations:store]
=/ assocs=(list [=md-resource:store grp=resource =metadatum:store])
~(tap by associations)
:- (send-diff %initial-group group associations)
|-
?~ assocs
state
=, assocs
?> =(group grp.i)
=^ cards state
(handle-add group [md-resource metadatum]:i)
$(assocs t)
::
++ metadata-for-app
|= =app-name
^- ^associations
%- ~(gas by *^associations)
%+ turn ~(tap in (~(gut by app-indices) app-name ~))
|= [=group-path =app-path]
:- [group-path [app-name app-path]]
(~(got by associations) [group-path [app-name app-path]])
|= =app-name:store
^+ associations
%+ roll ~(tap in (~(gut by app-indices) app-name ~))
|= [[group=resource rid=resource] out=associations:store]
=/ =md-resource:store
[app-name rid]
=/ [resource =metadatum:store]
(~(got by associations) md-resource)
(~(put by out) md-resource [group metadatum])
::
++ metadata-for-group
|= =group-path
^- ^associations
%- ~(gas by *^associations)
%+ turn ~(tap in (~(gut by group-indices) group-path ~))
|= =md-resource
:- [group-path md-resource]
(~(got by associations) [group-path md-resource])
|= group=resource
=/ resources=(set md-resource:store)
(~(get ju group-indices) group)
%+ roll
~(tap in resources)
|= [=md-resource:store out=associations:store]
=/ [resource =metadatum:store]
(~(got by associations) md-resource)
(~(put by out) md-resource [group metadatum])
::
++ send-diff
|= [=app-name upd=metadata-update]
|= =update:store
^- (list card)
|^
%- zing
:~ (update-subscribers /all upd)
(update-subscribers /updates upd)
(update-subscribers [%app-name app-name ~] upd)
:~ (update-subscribers /all update)
(update-subscribers /updates update)
==
::
++ update-subscribers
|= [pax=path upd=metadata-update]
|= [pax=path =update:store]
^- (list card)
[%give %fact ~[pax] %metadata-update !>(upd)]~
[%give %fact ~[pax] %metadata-update !>(update)]~
--
--

259
pkg/arvo/app/sane.hoon Normal file
View File

@ -0,0 +1,259 @@
:: %sane: sanity checker for the landscape suite of applications
::
:: Userspace currently uses certain identifiers as foreign keys, and
:: expects those foreign keys to exist in a number of locations.
::
:: These foreign key relationships are prone to breaking during OTAs
:: and there are enough of them that they rarely get tested for
:: manually. %sane is a gall app that will check the validity of
:: these relationships, and fix them if asked.
::
:: Sane has a companion thread, -sane, which should be run instead
:: of attempting :sane %fix directly from the dojo.
::
:: Pokes:
:: %fix - Find issues and fix them
:: %check - Find issues and print them
::
:: Currently validates:
:: - Entries in {contact,metadata,group} stores are in sync with
:: their hooks
:: - Each group has its associated metadata and contacts
:: - Each graph is being synced
::
/- *metadata-store, contacts=contact-store, *group
/+ default-agent, verb, dbug, resource, graph, mdl=metadata, group
~% %sane-app ..part ~
|%
+$ card card:agent:gall
::
+$ state-zero [%0 ~]
::
+$ issue
$% [%lib-pull-hook-desync app=term =resource]
[%lib-push-hook-desync app=term =resource]
[%dangling-md =resource]
==
::
+$ issues
(list issue)
::
+$ action ?(%check %fix)
--
::
=| state-zero
=* state -
::
%- agent:dbug
%+ verb |
^- agent:gall
=<
|_ =bowl:gall
+* this .
sane-core +>
sc ~(. sane-core bowl)
def ~(. (default-agent this %|) bowl)
::
++ on-init
^- (quip card _this)
`this
++ on-save !>(state)
::
++ on-load
|= =vase
`this
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
?. =(%noun mark)
(on-poke:def mark vase)
=/ act=action !<(action vase)
=^ cards state
?- act
%fix fix-sane:sc
%check print-sane:sc
==
[cards this]
::
++ on-agent on-agent:def
++ on-watch on-watch:def
++ on-leave on-leave:def
::
++ on-peek
|= =path
^- (unit (unit cage))
?: ?=([%x %bad-path ~] path) ~
(on-peek:def path)
::
++ on-arvo on-arvo:def
++ on-fail on-fail:def
--
::
|_ =bowl:gall
++ gra ~(. graph bowl)
++ md ~(. mdl bowl)
++ grp ~(. group bowl)
::
++ foreign-keys
|_ =issues
++ fk-core .
::
++ abet
^+ issues
issues
::
++ abet-fix
^- (list card)
(zing (turn issues fix-issue))
::
++ report
|= =issue
fk-core(issues (snoc issues issue))
::
++ report-many
|= many=^issues
fk-core(issues (weld issues many))
::
++ check-all
=> (lib-hooks-desync %group scry-groups)
=> (lib-hooks-desync %graph get-keys:gra)
=> (lib-hooks-desync %metadata scry-groups)
=> contacts
metadata
::
++ contacts
^+ fk-core
=/ groups=(list resource)
~(tap in scry-groups)
|-
?~ groups
fk-core
=* group i.groups
=? fk-core
?& (is-managed:grp group)
!=(our.bowl entity.group)
!(~(has in (tracking-pull-hook %contact-pull-hook)) group)
==
(report %lib-pull-hook-desync %contact-pull-hook group)
$(groups t.groups)
::
++ metadata
^+ fk-core
=/ md-groups=(list resource)
~(tap in ~(key by md-group-indices))
|-
?~ md-groups
fk-core
=? fk-core !(~(has in scry-groups) i.md-groups)
(report %dangling-md i.md-groups)
$(md-groups t.md-groups)
::
++ lib-hooks-desync
|= [app=term storing=(set resource)]
^+ fk-core
=/ tracking
(tracking-pull-hook (pull-hook-name app))
=/ sharing
(sharing-push-hook (push-hook-name app))
=/ resources
~(tap in storing)
|-
?~ resources
fk-core
=* rid i.resources
=? fk-core &(=(our.bowl entity.rid) !(~(has in sharing) rid))
(report %lib-push-hook-desync (push-hook-name app) rid)
=? fk-core &(!=(our.bowl entity.rid) !(~(has in tracking) rid))
(report %lib-pull-hook-desync (pull-hook-name app) rid)
$(resources t.resources)
--
::
++ pull-hook-name
|= app=term
:(join-cord app '-' %pull-hook)
::
++ push-hook-name
|= app=term
:(join-cord app '-' %push-hook)
::
++ fix-sane
^- (quip card _state)
=/ cards=(list card)
=> foreign-keys
=> check-all
abet-fix
[cards state]
::
++ print-sane
^- (quip card _state)
=/ =issues
=> foreign-keys
=> check-all
abet
~& issues
`state
::
++ fix-issue
|= =issue
|^
^- (list card)
?- -.issue
::
%lib-pull-hook-desync
=* rid resource.issue
(poke-our app.issue pull-hook-action+!>([%add entity.rid rid]))^~
::
%lib-push-hook-desync
(poke-our app.issue push-hook-action+!>([%add resource.issue]))^~
::
%dangling-md
=/ app-indices
(~(get ju md-group-indices) resource.issue)
%+ turn
~(tap in app-indices)
|= =md-resource
^- card
(poke-our %metadata-store metadata-action+!>([%remove resource.issue md-resource]))
==
::
++ poke-our
|= [app=term =cage]
^- card
[%pass /fix %agent [our.bowl app] %poke cage]
--
::
++ join-cord
(cury cat 3)
::
++ scry-groups
(scry ,(set resource) /y/group-store/groups)
::
++ tracking-pull-hook
|= hook=term
%+ scry
,(set resource)
/x/[hook]/tracking/noun
::
++ sharing-push-hook
|= hook=term
%+ scry
,(set resource)
/x/[hook]/sharing/noun
::
++ md-group-indices
(scry (jug resource md-resource) /y/metadata-store/group-indices)
::
++ scry
|* [=mold =path]
^- mold
?> ?=(^ path)
?> ?=(^ t.path)
.^ mold
(cat 3 %g i.path)
(scot %p our.bowl)
i.t.path
(scot %da now.bowl)
t.t.path
==
--

View File

@ -0,0 +1,169 @@
/- *settings
/+ verb, dbug, default-agent
|%
+$ card card:agent:gall
+$ versioned-state
$% state-0
==
+$ state-0
$: %0
=settings
==
--
=| state-0
=* state -
::
%- agent:dbug
%+ verb |
^- agent:gall
=<
|_ bol=bowl:gall
+* this .
do ~(. +> bol)
def ~(. (default-agent this %|) bol)
::
++ on-init
^- (quip card _this)
`this
::
++ on-save !>(state)
::
++ on-load
|= =old=vase
^- (quip card _this)
=/ old !<(versioned-state old-vase)
?- -.old
%0 [~ this(state old)]
==
::
++ on-poke
|= [mar=mark vas=vase]
^- (quip card _this)
?> (team:title our.bol src.bol)
?. ?=(%settings-event mar)
(on-poke:def mar vas)
=/ evt=event !<(event vas)
=^ cards state
?- -.evt
%put-bucket (put-bucket:do key.evt bucket.evt)
%del-bucket (del-bucket:do key.evt)
%put-entry (put-entry:do buc.evt key.evt val.evt)
%del-entry (del-entry:do buc.evt key.evt)
==
[cards this]
::
++ on-watch
|= pax=path
^- (quip card _this)
?> (team:title our.bol src.bol)
?+ pax (on-watch:def pax)
[%all ~]
[~ this]
::
[%bucket @ ~]
=* bucket-key i.t.pax
?> (~(has by settings) bucket-key)
[~ this]
::
[%entry @ @ ~]
=* bucket-key i.t.pax
=* entry-key i.t.t.pax
=/ bucket (~(got by settings) bucket-key)
?> (~(has by bucket) entry-key)
[~ this]
==
::
++ on-peek
|= pax=path
^- (unit (unit cage))
?+ pax (on-peek:def pax)
[%x %all ~]
``settings-data+!>(all+settings)
::
[%x %bucket @ ~]
=* buc i.t.t.pax
=/ bucket=(unit bucket) (~(get by settings) buc)
?~ bucket [~ ~]
``settings-data+!>(bucket+u.bucket)
::
[%x %entry @ @ ~]
=* buc i.t.t.pax
=* key i.t.t.t.pax
=/ =bucket (fall (~(get by settings) buc) ~)
=/ entry=(unit val) (~(get by bucket) key)
?~ entry [~ ~]
``settings-data+!>(entry+u.entry)
==
::
++ on-agent on-agent:def
++ on-leave on-leave:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
--
::
|_ bol=bowl:gall
::
:: +put-bucket: put a bucket in the top level settings map, overwriting if it
:: already exists
::
++ put-bucket
|= [=key =bucket]
^- (quip card _state)
=/ pas=(list path)
:~ /all
/bucket/[key]
==
:- [(give-event pas %put-bucket key bucket)]~
state(settings (~(put by settings) key bucket))
::
:: +del-bucket: delete a bucket from the top level settings map
::
++ del-bucket
|= =key
^- (quip card _state)
=/ pas=(list path)
:~ /all
/bucket/[key]
==
:- [(give-event pas %del-bucket key)]~
state(settings (~(del by settings) key))
::
:: +put-entry: put an entry in a bucket, overwriting if it already exists
:: if bucket does not yet exist, create it
::
++ put-entry
|= [buc=key =key =val]
^- (quip card _state)
=/ pas=(list path)
:~ /all
/bucket/[buc]
/entry/[buc]/[key]
==
=/ =bucket (fall (~(get by settings) buc) ~)
=. bucket (~(put by bucket) key val)
:- [(give-event pas %put-entry buc key val)]~
state(settings (~(put by settings) buc bucket))
::
:: +del-entry: delete an entry from a bucket, fail quietly if bucket does not
:: exist
::
++ del-entry
|= [buc=key =key]
^- (quip card _state)
=/ pas=(list path)
:~ /all
/bucket/[buc]
/entry/[buc]/[key]
==
=/ bucket=(unit bucket) (~(get by settings) buc)
?~ bucket
[~ state]
=. u.bucket (~(del by u.bucket) key)
:- [(give-event pas %del-entry buc key)]~
state(settings (~(put by settings) buc u.bucket))
::
++ give-event
|= [pas=(list path) evt=event]
^- card
[%give %fact pas %settings-event !>(evt)]
--

View File

@ -267,6 +267,10 @@
^- card
[%pass /bind %arvo %e %connect [~ /spider] %spider]
::
++ new-thread-id
|= file=term
:((cury cat 3) file '--' (scot %uv (sham eny.bowl)))
::
++ handle-http-request
|= [eyre-id=@ta =inbound-request:eyre]
^- (quip card _state)
@ -277,8 +281,7 @@
=* input-mark i.t.site.url
=* thread i.t.t.site.url
=* output-mark i.t.t.t.site.url
=/ =tid
(scot %uv (sham eny.bowl))
=/ =tid (new-thread-id thread)
=. serving.state
(~(put by serving.state) tid [eyre-id output-mark])
=+ .^
@ -334,7 +337,7 @@
?~ parent-tid
/
(~(got by tid.state) u.parent-tid)
=/ new-tid (fall use (scot %uv (sham eny.bowl)))
=/ new-tid (fall use (new-thread-id file))
=/ =yarn (snoc parent-yarn new-tid)
::
?: (has-yarn running.state yarn)

120
pkg/arvo/lib/agentio.hoon Normal file
View File

@ -0,0 +1,120 @@
=>
|%
++ card card:agent:gall
--
::
|_ =bowl:gall
++ scry
|* [desk=@tas =path]
?> ?=(^ path)
?> ?=(^ t.path)
%+ weld
/(scot %p our.bowl)/[desk]/(scot %da now.bowl)
t.t.path
::
++ pass
|_ =wire
++ poke
|= [=dock =cage]
[%pass wire %agent dock %poke cage]
::
++ poke-our
|= [app=term =cage]
^- card
(poke [our.bowl app] cage)
::
++ poke-self
|= =cage
^- card
(poke-our dap.bowl cage)
::
++ arvo
|= =note-arvo
^- card
[%pass wire %arvo note-arvo]
::
++ watch
|= [=dock =path]
[%pass (watch-wire path) %agent dock %watch path]
::
++ watch-our
|= [app=term =path]
(watch [our.bowl app] path)
::
++ watch-wire
|= =path
^+ wire
?. ?=(~ wire)
wire
agentio-watch+path
::
++ leave
|= =dock
[%pass wire %agent dock %leave ~]
::
++ leave-our
|= app=term
(leave our.bowl app)
::
++ leave-path
|= [=dock =path]
=. wire
(watch-wire path)
(leave dock)
::
++ wait
|= p=@da
(arvo %b %wait p)
::
++ rest
|= p=@da
(arvo %b %wait p)
::
++ warp
|= [wer=ship =riff:clay]
(arvo %c %warp wer riff)
::
++ warp-our
|= =riff:clay
(warp our.bowl riff)
::
:: right here, right now
++ warp-slim
|= [genre=?(%sing %next) =care:clay =path]
=/ =mood:clay
[care r.byk.bowl path]
=/ =rave:clay
?:(?=(%sing genre) [genre mood] [genre mood])
(warp-our q.byk.bowl `rave)
--
::
++ fact-curry
|* [=mark =mold]
|= [paths=(list path) fac=mold]
(fact mark^!>(fac) paths)
::
++ fact-kick
|= [=path =cage]
^- (list card)
:~ (fact cage ~[path])
(kick ~[path])
==
::
++ fact-init
|= =cage
^- card
[%give %fact ~ cage]
::
++ fact
|= [=cage paths=(list path)]
^- card
[%give %fact paths cage]
::
++ kick
|= paths=(list path)
[%give %kick paths ~]
::
++ kick-only
|= [=ship paths=(list path)]
[%give %kick paths `ship]
--

View File

@ -129,6 +129,27 @@
++ launch 4.601.630
++ public launch
--
::
:: Local contract addresses
::
:: These addresses are only reproducible if you use the deploy
:: script in bridge
::
++ local-contracts
|%
++ ecliptic
0x56db.68f2.9203.ff44.a803.faa2.404a.44ec.bb7a.7480
++ azimuth
0x863d.9c2e.5c4c.1335.96cf.ac29.d552.55f0.d0f8.6381
++ delegated-sending
0xb71c.0b6c.ee1b.cae5.6dfe.95cd.9d3e.41dd.d7ea.fc43
++ linear-star-release
0x3c3.dc12.be65.8158.d1d7.f9e6.6e08.ec40.99c5.68e4
++ conditional-star-release
0x35eb.3b10.2d9c.1b69.ac14.69c1.b1fe.1799.850c.d3eb
++ launch 0
++ public 0
--
::
:: ++ azimuth 0x863d.9c2e.5c4c.1335.96cf.ac29.d552.55f0.d0f8.6381 :: local bridge
:: hashes of ship event signatures

View File

@ -1,265 +0,0 @@
/- *contact-view, *contact-hook
/+ group-store, resource
|%
++ nu :: parse number as hex
|= jon=json
?> ?=([%s *] jon)
(rash p.jon hex)
::
++ hook-update-to-json
|= upd=contact-hook-update
=, enjs:format
^- json
%+ frond %contact-hook-update
%- pairs
%+ turn ~(tap by synced.upd)
|= [pax=^path shp=^ship]
^- [cord json]
[(spat pax) s+(scot %p shp)]
::
++ rolodex-to-json
|= rolo=rolodex
=, enjs:format
^- json
%- pairs
%+ turn ~(tap by rolo)
|= [pax=^path =contacts]
^- [cord json]
:- (spat pax)
(contacts-to-json pax contacts)
::
++ contacts-to-json
|= [=path con=contacts]
^- json
%- pairs:enjs:format
%+ turn ~(tap by con)
|= [=ship =contact]
^- [cord json]
[(crip (slag 1 (scow %p ship))) (contact-to-json path ship contact)]
::
++ contact-to-json
|= [=path =ship con=contact]
^- json
%- pairs:enjs:format
:~ [%nickname s+nickname.con]
[%email s+email.con]
[%phone s+phone.con]
[%website s+website.con]
[%notes s+notes.con]
[%color s+(scot %ux color.con)]
[%avatar (avatar-to-json path ship avatar.con)]
==
::
++ edit-to-json
|= [=path =ship edit=edit-field]
^- json
%+ frond:enjs:format -.edit
?- -.edit
%nickname s+nickname.edit
%email s+email.edit
%phone s+phone.edit
%website s+website.edit
%notes s+notes.edit
%color s+(scot %ux color.edit)
%avatar (avatar-to-json path ship avatar.edit)
==
::
++ avatar-to-json
|= [=path =ship avat=(unit avatar)]
^- json
?~ avat ~
?- -.u.avat
%octt
:- %s
%- crip
%- zing
:~ "/contact-view"
(trip (spat path))
"/"
(trip (scot %p ship))
==
::
%url s+url.u.avat
==
::
++ update-to-json
|= upd=contact-update
=, enjs:format
^- json
%+ frond %contact-update
%- pairs
:~
?: ?=(%initial -.upd)
[%initial (rolodex-to-json rolodex.upd)]
?: ?=(%create -.upd)
[%create (pairs [%path (path path.upd)]~)]
?: ?=(%delete -.upd)
[%delete (pairs [%path (path path.upd)]~)]
?: ?=(%add -.upd)
:- %add
%- pairs
:~ [%path (path path.upd)]
[%ship (ship ship.upd)]
[%contact (contact-to-json path.upd ship.upd contact.upd)]
==
?: ?=(%remove -.upd)
:- %remove
%- pairs
:~ [%path (path path.upd)]
[%ship (ship ship.upd)]
==
?: ?=(%edit -.upd)
:- %edit
%- pairs
:~ [%path (path path.upd)]
[%ship (ship ship.upd)]
[%edit-field (edit-to-json path.upd ship.upd edit-field.upd)]
==
[*@t *^json]
==
::
++ json-to-view-action
|= jon=json
^- contact-view-action
=, dejs:format
=< (parse-json jon)
|%
++ parse-json
%- of
:~ [%create create]
[%delete delete]
[%join dejs:resource]
[%invite invite]
[%remove remove]
[%share share]
==
::
++ create
%- ot
:~ [%name so]
[%policy policy:dejs:group-store]
[%title so]
[%description so]
==
::
++ invite
%- ot
:~ [%resource dejs:resource]
[%ship (su ;~(pfix sig fed:ag))]
[%text so]
==
::
++ delete (ot [%path pa]~)
::
++ remove
%- ot
:~ [%path pa]
[%ship (su ;~(pfix sig fed:ag))]
==
::
++ share
%- ot
:~ [%recipient (su ;~(pfix sig fed:ag))]
[%path pa]
[%ship (su ;~(pfix sig fed:ag))]
[%contact cont]
==
--
::
++ json-to-action
|= jon=json
^- contact-action
=, dejs:format
=< (parse-json jon)
|%
++ parse-json
%- of
:~ [%create create]
[%delete delete]
[%add add]
[%remove remove]
[%edit edit]
==
::
++ create
(ot [%path pa]~)
::
++ delete
(ot [%path pa]~)
::
++ add
%- ot
:~ [%path pa]
[%ship (su ;~(pfix sig fed:ag))]
[%contact cont]
==
::
++ remove
%- ot
:~ [%path pa]
[%ship (su ;~(pfix sig fed:ag))]
==
::
++ edit
%- ot
:~ [%path pa]
[%ship (su ;~(pfix sig fed:ag))]
[%edit-field edit-fi]
==
--
::
++ octet
%- ot:dejs:format
:~ [%p ni:dejs:format]
[%q so:dejs:format]
==
::
++ avat
|= jon=json
^- avatar
|^
=/ =avatar (parse-json jon)
?- -.avatar
%url avatar
%octt
=. octs.avatar (need (de:base64:mimes:html q.octs.avatar))
avatar
==
::
++ parse-json
%- of:dejs:format
:~ [%octt octt]
[%url url]
==
::
++ octt
%- ot:dejs:format
:~ [%content-type so:dejs:format]
[%octs octet]
==
::
++ url so:dejs:format
--
::
++ cont
%- ot:dejs:format
:~ [%nickname so:dejs:format]
[%email so:dejs:format]
[%phone so:dejs:format]
[%website so:dejs:format]
[%notes so:dejs:format]
[%color nu]
[%avatar (mu:dejs:format avat)]
==
::
++ edit-fi
%- of:dejs:format
:~ [%nickname so:dejs:format]
[%email so:dejs:format]
[%phone so:dejs:format]
[%website so:dejs:format]
[%notes so:dejs:format]
[%color nu]
[%avatar (mu:dejs:format avat)]
==
--

View File

@ -0,0 +1,184 @@
/- sur=contact-store
/+ res=resource
=< [sur .]
=, sur
|%
++ nu :: parse number as hex
|= jon=json
?> ?=([%s *] jon)
(rash p.jon hex)
::
++ enjs
=, enjs:format
|%
++ update
|= upd=^update
^- json
%+ frond %contact-update
%- pairs
:_ ~
^- [cord json]
?- -.upd
%initial
:- %initial
%- pairs
:~ [%rolodex (rolo rolodex.upd)]
[%is-public b+is-public.upd]
==
::
%add
:- %add
%- pairs
:~ [%ship (ship ship.upd)]
[%contact (cont contact.upd)]
==
::
%remove
:- %remove
(pairs [%ship (ship ship.upd)]~)
::
%edit
:- %edit
%- pairs
:~ [%ship (ship ship.upd)]
[%edit-field (edit edit-field.upd)]
==
::
%allow
:- %allow
(pairs [%beings (beng beings.upd)]~)
::
%disallow
:- %disallow
(pairs [%beings (beng beings.upd)]~)
::
%set-public
[%set-public b+public.upd]
==
::
++ rolo
|= =rolodex
^- json
%- pairs
%+ turn ~(tap by rolodex)
|= [=^ship =contact]
^- [cord json]
[(scot %p ship) (cont contact)]
::
++ cont
|= =contact
^- json
%- pairs
:~ [%nickname s+nickname.contact]
[%bio s+bio.contact]
[%status s+status.contact]
[%color s+(scot %ux color.contact)]
[%avatar ?~(avatar.contact ~ s+u.avatar.contact)]
[%cover ?~(cover.contact ~ s+u.cover.contact)]
[%groups a+(turn ~(tap in groups.contact) (cork enjs-path:res (lead %s)))]
[%last-updated (time last-updated.contact)]
==
::
++ edit
|= field=edit-field
^- json
%+ frond -.field
?- -.field
%nickname s+nickname.field
%bio s+bio.field
%status s+status.field
%color s+(scot %ux color.field)
%avatar ?~(avatar.field ~ s+u.avatar.field)
%cover ?~(cover.field ~ s+u.cover.field)
%add-group s+(enjs-path:res resource.field)
%remove-group s+(enjs-path:res resource.field)
==
::
++ beng
|= =beings
^- json
?- -.beings
%ships [%a (turn ~(tap in ships.beings) |=(s=^ship s+(scot %p s)))]
%group (enjs:res resource.beings)
==
--
::
++ dejs
=, dejs:format
|%
++ update
|= jon=json
^- ^update
=< (decode jon)
|%
++ decode
%- of
:~ [%initial initial]
[%add add-contact]
[%remove remove-contact]
[%edit edit-contact]
[%allow beings]
[%disallow beings]
[%set-public bo]
==
::
++ initial
%- ot
:~ [%rolodex (op ;~(pfix sig fed:ag) cont)]
[%is-public bo]
==
::
++ add-contact
%- ot
:~ [%ship (su ;~(pfix sig fed:ag))]
[%contact cont]
==
::
++ remove-contact (ot [%ship (su ;~(pfix sig fed:ag))]~)
::
++ edit-contact
%- ot
:~ [%ship (su ;~(pfix sig fed:ag))]
[%edit-field edit]
==
::
++ beings
%- of
:~ [%ships (as (su ;~(pfix sig fed:ag)))]
[%group dejs:res]
==
::
++ cont
%- ot
:~ [%nickname so]
[%bio so]
[%status so]
[%color nu]
[%avatar (mu so)]
[%cover (mu so)]
[%groups (as dejs:res)]
[%last-updated di]
==
::
++ edit
%- of
:~ [%nickname so]
[%bio so]
[%status so]
[%color nu]
[%avatar (mu so)]
[%cover (mu so)]
[%add-group dejs:res]
[%remove-group dejs:res]
==
--
--
::
++ share-dejs
=, dejs:format
|%
++ share
^- $-(json [%share ship])
(of share+(su ;~(pfix sig fed:ag)) ~)
--
--

99
pkg/arvo/lib/contact.hoon Normal file
View File

@ -0,0 +1,99 @@
/- store=contact-store, *resource
/+ group, grpl=group
|_ =bowl:gall
+* grp ~(. grpl bowl)
++ scry-for
|* [=mold =path]
.^ mold
%gx
(scot %p our.bowl)
%contact-store
(scot %da now.bowl)
(snoc `^path`path %noun)
==
::
++ resource-for-update
|= =vase
^- (list resource)
|^
=/ =update:store !<(update:store vase)
?- -.update
%initial ~
%add (rids-for-ship ship.update)
%remove (rids-for-ship ship.update)
%edit (rids-for-ship ship.update)
%allow ~
%disallow ~
%set-public ~
==
::
++ rids-for-ship
|= s=ship
^- (list resource)
:: if the ship is in any group that I am pushing updates for, push
:: it out to that resource.
::
=/ rids
%+ skim ~(tap in scry-sharing)
|= r=resource
(is-member:grp s r)
?. =(s our.bowl)
rids
(snoc rids [our.bowl %''])
--
++ scry-sharing
.^ (set resource)
%gx
(scot %p our.bowl)
%contact-push-hook
(scot %da now.bowl)
/sharing/noun
==
::
++ get-contact
|= =ship
^- (unit contact:store)
=/ =rolodex:store
(scry-for rolodex:store /all)
(~(get by rolodex) ship)
::
++ scry-is-public
.^ ?
%gx
(scot %p our.bowl)
%contact-store
(scot %da now.bowl)
/is-public/noun
==
::
++ is-allowed
|= [rid=resource =ship]
^- ?
=/ grp ~(. group bowl)
=/ allowed-groups (scry-for (set resource) /allowed-groups)
?| :: if they are requesting our personal profile, check if we are
:: either public, or if they are on the allowed-ships list.
:: this is used for direct messages and leap searches
::
?& =(rid [our.bowl %''])
?| :: if our profile is public, allow
::
scry-is-public
:: if the requester is an allowed-ship, allow
::
(scry-for ? /allowed-ship/(scot %p ship))
:: if the requester of our profile is the host of one of
:: our allowed-groups, allow
::
%+ lien ~(tap in allowed-groups)
|= res=resource
=(entity.res ship)
== ==
:: if they are requesting our contact data within a group,
:: we make sure that we are sharing that group,
:: and that they are a member of the group
::
?& (~(has in scry-sharing) rid)
(~(has in (members:grp rid)) ship)
== ==
--

View File

@ -11,6 +11,27 @@
(snoc `^path`path %noun)
==
::
++ resource-for-update
|= =vase
^- (list resource)
=/ =update:store !<(update:store vase)
?- -.q.update
%add-graph ~[resource.q.update]
%remove-graph ~[resource.q.update]
%add-nodes ~[resource.q.update]
%remove-nodes ~[resource.q.update]
%add-signatures ~[resource.uid.q.update]
%remove-signatures ~[resource.uid.q.update]
%archive-graph ~[resource.q.update]
%unarchive-graph ~
%add-tag ~
%remove-tag ~
%keys ~
%tags ~
%tag-queries ~
%run-updates ~[resource.q.update]
==
::
++ get-graph
|= res=resource
^- update:store
@ -104,4 +125,8 @@
index (snoc index atom)
nodes (tap:orm:store p.children.node)
==
::
++ get-mark
|= res=resource
(scry-for ,(unit mark) /graph-mark/(scot %p entity.res)/[name.res])
--

View File

@ -127,38 +127,17 @@
++ tags
|= =^tags
^- json
|^
:- %o
(~(uni by app) group)
++ group
^- (map @t json)
%- malt
%+ murn
~(tap by tags)
|= [=^tag ships=(^set ^ship)]
^- (unit [@t json])
?^ tag
~
`[tag (set ship ships)]
++ app
^- (map @t json)
=| app-tags=(map @t json)
=/ tags ~(tap by tags)
|-
?~ tags
app-tags
=* tag i.tags
?@ p.tag
$(tags t.tags)
=/ app=json
(~(gut by app-tags) app.p.tag [%o ~])
?> ?=(%o -.app)
=. p.app
(~(put by p.app) tag.p.tag (set ship q.tag))
=. app-tags
(~(put by app-tags) app.p.tag app)
$(tags t.tags)
--
%- pairs
%+ turn ~(tap by tags)
|= [=^tag ships=(^set ^ship)]
^- [@t json]
:_ (set ship ships)
?@ tag tag
;: (cury cat 3)
app.tag '\\'
tag.tag '\\'
(enjs-path:resource resource.tag)
==
::
++ set
|* [item=$-(* json) sit=(^set)]
@ -167,6 +146,7 @@
%+ turn
~(tap in sit)
item
::
++ tag
|= =^tag
^- json
@ -175,6 +155,7 @@
%- pairs
:~ app+s+app.tag
tag+s+tag.tag
resource+s+(enjs-path:resource resource.tag)
==
::
++ policy
@ -366,6 +347,7 @@
%. json
%- ot
:~ app+so
resource+dejs-path:resource
tag+so
==

View File

@ -0,0 +1,92 @@
/- sur=group-view, spider
/+ resource, strandio, metadata=metadata-store, store=group-store
^?
=< [. sur]
=, sur
|%
++ dejs
=, dejs:format
|%
++ action
^- $-(json ^action)
%- of
:~ create+create
remove+remove
join+join
leave+leave
invite+invite
==
::
++ create
%- ot
:~ name+so
policy+policy:dejs:store
title+so
description+so
==
::
++ remove dejs:resource
::
++ leave dejs:resource
::
++ join
%- ot
:~ resource+dejs:resource
ship+(su ;~(pfix sig fed:ag))
==
::
++ invite
%- ot
:~ resource+dejs:resource
ships+(as (su ;~(pfix sig fed:ag)))
description+so
==
--
::
++ enjs
=, enjs:format
|%
++ update
|= upd=^update
%+ frond %group-view-update
%+ frond -.upd
?- -.upd
%initial (initial +.upd)
%progress (progress +.upd)
==
::
++ progress
|= [rid=resource prog=^progress]
%- pairs
:~ resource+s+(enjs-path:resource rid)
progress+s+prog
==
::
++ initial
|= init=(map resource ^progress)
%- pairs
%+ turn ~(tap by init)
|= [rid=resource prog=^progress]
:_ s+prog
(enjs-path:resource rid)
--
++ cleanup-md
|= rid=resource
=/ m (strand:spider ,~)
^- form:m
;< =associations:metadata bind:m
%+ scry:strandio associations:metadata
%+ weld /gx/metadata-store/group
(snoc (en-path:resource rid) %noun)
~& associations
=/ assocs=(list [=md-resource:metadata association:metadata])
~(tap by associations)
|-
=* loop $
?~ assocs
(pure:m ~)
;< ~ bind:m
%+ poke-our:strandio %metadata-store
metadata-action+!>([%remove rid md-resource.i.assocs])
loop(assocs t.assocs)
--

View File

@ -1,16 +1,27 @@
/- *group, *metadata-store
/- *group
/+ store=group-store, resource
::
|_ =bowl:gall
+$ card card:agent:gall
::
++ resource-for-update
|= =vase
^- (list resource)
=/ =update:store !<(update:store vase)
?: ?=(%initial -.update)
~
~[resource.update]
::
++ scry-for
|* [=mold =path]
=. path
(snoc path %noun)
.^ mold
%gx
(scot %p our.bowl)
%group-store
(scot %da now.bowl)
(snoc `^path`path %noun)
path
==
++ scry-tag
|= [rid=resource =tag]
@ -21,38 +32,36 @@
~
`(~(gut by tags.u.group) tag ~)
::
++ scry-group-path
|= =path
%+ scry-for
(unit group)
[%groups path]
::
++ scry-group
|= rid=resource
%- scry-group-path
(en-path:resource rid)
%+ scry-for ,(unit group)
`path`groups+(en-path:resource rid)
::
++ scry-groups
.^ ,(set resource)
%gy
(scot %p our.bowl)
%group-store
(scot %da now.bowl)
/groups
==
::
++ members
|= rid=resource
%- members-from-path
(en-path:resource rid)
::
++ members-from-path
|= =group-path
^- (set ship)
=- members:(fall - *group)
(scry-group-path group-path)
=; =group
members.group
(fall (scry-group rid) *group)
::
++ is-member
|= [=ship =group-path]
|= [=ship group=resource]
^- ?
=- (~(has in -) ship)
(members-from-path group-path)
(members group)
::
++ is-admin
|= [=ship =group-path]
|= [=ship group=resource]
^- ?
=/ tags tags:(fall (scry-group-path group-path) *group)
=/ tags tags:(fall (scry-group group) *^group)
=/ admins=(set ^ship) (~(gut by tags) %admin ~)
(~(has in admins) ship)
:: +role-for-ship: get role for user
@ -85,31 +94,26 @@
[~ ~]
~
::
++ can-join-from-path
|= [=path =ship]
%+ scry-for
?
%+ welp
[%groups path]
/join/[(scot %p ship)]
::
++ can-join
|= [rid=resource =ship]
%+ can-join-from-path
(en-path:resource rid)
ship
%+ scry-for ,?
^- path
:- %groups
(weld (en-path:resource rid) /join/(scot %p ship))
::
++ is-managed-path
|= =path
^- ?
=/ group=(unit group)
(scry-group-path path)
?~ group %.n
!hidden.u.group
++ get-tagged-ships
|= [rid=resource =tag]
^- (set ship)
=/ grp=(unit group)
(scry-group rid)
?~ grp ~
(~(get ju tags.u.grp) tag)
::
++ is-managed
|= rid=resource
%- is-managed-path
(en-path:resource rid)
=/ group=(unit group)
(scry-group rid)
?~ group %.n
!hidden.u.group
::
--

View File

@ -76,6 +76,7 @@
set-dnd+bo
read-count+stats-index
read-each+read-graph-index
read-all+ul
==
--
::
@ -245,11 +246,9 @@
|= =(list ^group-contents)
^- json
:- %a
%+ murn list
%+ turn list
|= =^group-contents
?. ?=(?(%add-members %remove-members) -.group-contents)
~
`(update:enjs:group-store group-contents)
(update:enjs:group-store group-contents)
--
::
++ indexed-notification

View File

@ -90,10 +90,9 @@
%chat-cli
%herm
%contact-store
%contact-hook
%contact-view
%contact-push-hook
%contact-pull-hook
%metadata-store
%metadata-hook
%s3-store
%file-server
%glob
@ -105,6 +104,10 @@
%hark-group-hook
%hark-chat-hook
%observe-hook
%metadata-push-hook
%metadata-pull-hook
%group-view
%settings-store
==
::
++ deft-fish :: default connects
@ -247,7 +250,14 @@
=> (se-born | %home %hark-chat-hook)
=> (se-born | %home %hark-store)
=> (se-born | %home %observe-hook)
=> (se-born | %home %metadata-pull-hook)
=> (se-born | %home %metadata-push-hook)
(se-born | %home %herm)
=? ..on-load (lte hood-version %12)
=> (se-born | %home %contact-push-hook)
=> (se-born | %home %contact-pull-hook)
=> (se-born | %home %settings-store)
(se-born | %home %group-view)
..on-load
::
++ reap-phat :: ack connect

View File

@ -1,119 +0,0 @@
/- *metadata-store
|%
++ associations-to-json
|= =associations
=, enjs:format
^- json
%- pairs
%+ turn ~(tap by associations)
|= [[=group-path =md-resource] =metadata]
^- [cord json]
:-
%- crip
;: weld
(trip (spat group-path))
(weld "/" (trip app-name.md-resource))
(trip (spat app-path.md-resource))
==
%- pairs
:~ [%group-path (path group-path)]
[%app-name s+app-name.md-resource]
[%app-path (path app-path.md-resource)]
[%metadata (metadata-to-json metadata)]
==
::
++ json-to-action
|= jon=json
^- metadata-action
=, dejs:format
=< (parse-json jon)
|%
++ parse-json
%- of
:~ [%add add]
[%remove remove]
==
::
++ add
%- ot
:~ [%group-path pa]
[%resource md-resource]
[%metadata metadata]
==
++ remove
%- ot
:~ [%group-path pa]
[%resource md-resource]
==
::
++ nu
|= jon=json
?> ?=([%s *] jon)
(rash p.jon hex)
::
++ metadata
%- ot
:~ [%title so]
[%description so]
[%color nu]
[%date-created (se %da)]
[%creator (su ;~(pfix sig fed:ag))]
[%module so]
==
++ md-resource
%- ot
:~ [%app-name so]
[%app-path pa]
==
--
::
++ metadata-to-json
|= met=metadata
^- json
=, enjs:format
%- pairs
:~ [%title s+title.met]
[%description s+description.met]
[%color s+(scot %ux color.met)]
[%date-created s+(scot %da date-created.met)]
[%creator s+(scot %p creator.met)]
[%module s+module.met]
==
::
++ update-to-json
|= upd=metadata-update
^- json
=, enjs:format
%+ frond %metadata-update
%- pairs
:~ ?- -.upd
%add
:- %add
%- pairs
:~ [%group-path (path group-path.upd)]
[%app-name s+app-name.resource.upd]
[%app-path (path app-path.resource.upd)]
[%metadata (metadata-to-json metadata.upd)]
==
::
%update-metadata
:- %update-metadata
%- pairs
:~ [%group-path (path group-path.upd)]
[%app-name s+app-name.resource.upd]
[%app-path (path app-path.resource.upd)]
[%metadata (metadata-to-json metadata.upd)]
==
::
%remove
:- %remove
%- pairs
:~ [%group-path (path group-path.upd)]
[%app-name s+app-name.resource.upd]
[%app-path (path app-path.resource.upd)]
==
::
%associations
[%associations (associations-to-json associations.upd)]
== ==
--

View File

@ -0,0 +1,172 @@
/- sur=metadata-store
/+ resource
^?
=< [. sur]
=, sur
|%
++ enjs
=, enjs:format
|%
::
++ initial-group
|= [group=resource assocs=^associations]
%- pairs
:~ group+s+(enjs-path:resource group)
associations+(associations assocs)
==
::
++ associations
|= =^associations
=, enjs:format
^- json
%- pairs
%+ turn ~(tap by associations)
|= [=md-resource [group=resource =^metadatum]]
^- [cord json]
:-
%- crip
;: weld
(trip (spat (en-path:resource group)))
(weld "/" (trip app-name.md-resource))
(trip (spat (en-path:resource resource.md-resource)))
==
%- pairs
:~ [%group s+(enjs-path:resource group)]
[%app-name s+app-name.md-resource]
[%resource s+(enjs-path:resource resource.md-resource)]
[%metadata (^metadatum metadatum)]
==
::
++ metadatum
|= met=^metadatum
^- json
%- pairs
:~ [%title s+title.met]
[%description s+description.met]
[%color s+(scot %ux color.met)]
[%date-created s+(scot %da date-created.met)]
[%creator s+(scot %p creator.met)]
[%module s+module.met]
[%picture s+picture.met]
[%preview b+preview.met]
[%vip s+`@t`vip.met]
==
::
++ update
|= upd=^update
^- json
%+ frond %metadata-update
%- pairs
:~ ?- -.upd
%add
:- %add
%- pairs
:~ [%group s+(enjs-path:resource group.upd)]
[%app-name s+app-name.resource.upd]
[%resource s+(enjs-path:resource resource.resource.upd)]
[%metadata (metadatum metadatum.upd)]
==
%updated-metadata
:- %add
%- pairs
:~ [%group s+(enjs-path:resource group.upd)]
[%app-name s+app-name.resource.upd]
[%resource s+(enjs-path:resource resource.resource.upd)]
[%metadata (metadatum metadatum.upd)]
==
::
%remove
:- %remove
%- pairs
:~ [%group s+(enjs-path:resource group.upd)]
[%app-name s+app-name.resource.upd]
[%resource s+(enjs-path:resource resource.resource.upd)]
==
::
%associations
[%associations (associations associations.upd)]
::
%initial-group
[%initial-group (initial-group +.upd)]
::
== ==
::
++ hook-update
|= upd=^hook-update
%+ frond %metadata-hook-update
%+ frond -.upd
%- pairs
?- -.upd
%preview
:~ [%group s+(enjs-path:resource group.upd)]
[%channels (associations channels.upd)]
[%members (numb members.upd)]
[%channel-count (numb channel-count.upd)]
[%metadata (metadatum metadatum.upd)]
==
%req-preview
~[group+s+(enjs-path:resource group.upd)]
==
--
::
++ dejs
=, dejs:format
|%
++ action
%- of
:~ [%add add]
[%remove remove]
[%initial-group initial-group]
==
::
++ initial-group
|= json
[*resource *associations]
::
++ add
%- ot
:~ [%group dejs-path:resource]
[%resource md-resource]
[%metadata metadatum]
==
++ remove
%- ot
:~ [%group dejs-path:resource]
[%resource md-resource]
==
::
++ nu
|= jon=json
?> ?=([%s *] jon)
(rash p.jon hex)
::
++ vip
%- su
%- perk
:~ %reader-comments
%member-metadata
%$
==
::
++ metadatum
^- $-(json ^metadatum)
%- ot
:~ [%title so]
[%description so]
[%color nu]
[%date-created (se %da)]
[%creator (su ;~(pfix sig fed:ag))]
[%module so]
[%picture so]
[%preview bo]
[%vip vip]
==
::
++ md-resource
^- $-(json ^md-resource)
%- ot
:~ [%app-name so]
[%resource dejs-path:resource]
==
--
--

View File

@ -1,61 +1,100 @@
:: metadata: helpers for getting data from the metadata-store
::
/- *metadata-store
/+ res=resource
/- store=metadata-store
/+ resource, grpl=group
::
|_ =bowl:gall
+* grp ~(. grpl bowl)
::
++ get-preview
|= rid=resource
|^ ^- group-preview:store
?> (can-join:grp rid src.bowl)
=/ members
~(wyt in (members:grp rid))
=/ =metadatum:store
%- need
%+ mate (peek-metadatum %groups rid)
(peek-metadatum %graph rid)
[rid channels members channel-count metadatum]
::
++ channels
%- ~(gas by *associations:store)
%+ scag 5
%+ skim ~(tap by (app-metadata-for-group rid %graph))
|=([=md-resource:store group=resource =metadatum:store] preview.metadatum)
::
++ channel-count
~(wyt by (app-metadata-for-group rid %graph))
--
::
++ resource-for-update
|= =vase
^- (list resource)
=/ =update:store !<(update:store vase)
?. ?=(?(%add %remove %initial-group) -.update) ~
~[group.update]
::
++ app-paths-from-group
|= [=app-name =group-path]
^- (list app-path)
|= [=app-name:store group=resource]
^- (list resource)
%+ murn
%~ tap in
=- (~(gut by -) group-path ~)
.^ (jug ^group-path md-resource)
=- (~(gut by -) group ~)
.^ (jug resource md-resource:store)
%gy
(scot %p our.bowl)
%metadata-store
(scot %da now.bowl)
/group-indices
==
|= =md-resource
^- (unit app-path)
|= =md-resource:store
^- (unit resource)
?. =(app-name.md-resource app-name) ~
`app-path.md-resource
`resource.md-resource
::
++ peek-metadata
|= [app-name=term =group=resource:res =app=resource:res]
^- (unit metadata)
=/ group-cord=cord (scot %t (spat (en-path:res group-resource)))
=/ app-cord=cord (scot %t (spat (en-path:res app-resource)))
=/ our=cord (scot %p our.bowl)
=/ now=cord (scot %da now.bowl)
.^ (unit metadata)
++ app-metadata-for-group
|= [group=resource =app-name:store]
=/ =associations:store
(metadata-for-group group)
%- ~(gas by *associations:store)
%+ skim ~(tap by associations)
|= [=md-resource:store association:store]
=(app-name app-name.md-resource)
::
++ metadata-for-group
|= group=resource
.^ associations:store
%gx (scot %p our.bowl) %metadata-store (scot %da now.bowl)
%metadata group-cord app-name app-cord /noun
%group (snoc (en-path:resource group) %noun)
==
::
++ group-from-app-resource
|= [app=term =app=resource:res]
^- (unit resource:res)
=/ app-path (en-path:res app-resource)
=/ group-paths (groups-from-resource app app-path)
?~ group-paths
~
`(de-path:res i.group-paths)
::
++ groups-from-resource
|= =md-resource
^- (list group-path)
=; resources
%~ tap in
%+ ~(gut by resources)
md-resource
*(set group-path)
.^ (jug ^md-resource group-path)
++ md-resources-from-group
|= group=resource
=- (~(get ju -) group)
.^ (jug resource md-resource:store)
%gy
(scot %p our.bowl)
%metadata-store
(scot %da now.bowl)
/resource-indices
/group-indices
==
::
++ peek-association
|= [app-name=term rid=resource]
.^ (unit association:store)
%gx (scot %p our.bowl) %metadata-store (scot %da now.bowl)
%metadata app-name (snoc (en-path:resource rid) %noun)
==
::
++ peek-metadatum
|= =md-resource:store
%+ bind (peek-association md-resource)
|=(association:store metadatum)
::
++ peek-group
|= =md-resource:store
^- (unit resource)
%+ bind (peek-association md-resource)
|=(association:store group)
--

View File

@ -20,6 +20,22 @@
::
/- *pull-hook
/+ default-agent, resource
|%
:: JSON conversions
++ dejs
=, dejs:format
|%
++ action
%- of
:~ add+add
==
++ add
%- ot
:~ ship+(su ;~(pfix sig fed:ag))
resource+dejs:resource
==
--
--
::
::
|%
@ -30,12 +46,15 @@
:: .store-name: name of the store to send subscription updates to.
:: .update-mark: mark that updates will be tagged with
:: .push-hook-name: name of the corresponding push-hook
:: .no-validate: If true, don't validate that resource/wire/src match
:: up
::
+$ config
$: store-name=term
update=mold
update-mark=term
push-hook-name=term
no-validate=_|
==
::
:: $base-state-0: state for the pull hook
@ -106,6 +125,14 @@
++ on-pull-kick
|~ resource
*(unit path)
:: +resource-for-update: get resources from vase
::
:: This should be identical to the +resource-for-update arm in the
:: corresponding push-hook
::
++ resource-for-update
|~ vase
*(list resource)
::
:: from agent:gall
++ on-init
@ -232,14 +259,23 @@
++ on-poke
|= [=mark =vase]
^- [(list card:agent:gall) agent:gall]
?> (team:title our.bowl src.bowl)
?. =(mark %pull-hook-action)
?+ mark
=^ cards pull-hook
(on-poke:og mark vase)
[cards this]
=^ cards state
(poke-hook-action:hc !<(action vase))
[cards this]
::
%sane
?> (team:title [our src]:bowl)
=^ cards state
poke-sane:hc
[cards this]
::
%pull-hook-action
?> (team:title [our src]:bowl)
=^ cards state
(poke-hook-action:hc !<(action vase))
[cards this]
==
::
++ on-watch
|= =path
@ -309,10 +345,49 @@
++ on-peek
|= =path
^- (unit (unit cage))
(on-peek:og path)
?: =(/x/dbug/state path)
``noun+(slop !>(state(inner-state *vase)) on-save:og)
?. =(/x/tracking path)
(on-peek:og path)
``noun+!>(~(key by tracking))
--
|_ =bowl:gall
+* og ~(. pull-hook bowl)
++ poke-sane
^- (quip card:agent:gall _state)
=/ cards
restart-subscriptions
~? > ?=(^ cards)
"Fixed subscriptions in {<dap.bowl>}"
:_ state
restart-subscriptions
::
++ check-subscription
|= [rid=resource =ship]
^- ?
%+ lien
~(tap in ~(key by wex.bowl))
|= [=wire her=^ship app=term]
^- ?
?& =(app push-hook-name.config)
=(ship her)
=((scag 4 wire) /helper/pull-hook/pull/resource)
=(`rid (de-path-soft:resource (slag 4 wire)))
==
::
++ restart-subscriptions
^- (list card:agent:gall)
%- zing
%+ turn
~(tap by tracking)
|= [rid=resource =ship]
^- (list card:agent:gall)
?: (check-subscription rid ship) ~
~& >> "restarting: {<rid>}"
=/ pax=(unit path)
(on-pull-kick:og rid)
?~ pax ~
(watch-resource rid u.pax)
::
++ mule-scry
|= [ref=* raw=*]
@ -424,24 +499,30 @@
/helper/pull-hook
wire
::
++ get-conversion
.^ tube:clay
%cc (scot %p our.bowl) %home (scot %da now.bowl)
/[update-mark.config]/resource
==
::
++ give-update
^- card
[%give %fact ~[/tracking] %pull-hook-update !>(tracking)]
::
++ check-src
|= resources=(set resource)
^- ?
%+ roll ~(tap in resources)
|= [rid=resource out=_|]
?: out %.y
?~ ship=(~(get by tracking) rid)
%.n
=(src.bowl u.ship)
::
++ update-store
|= [wire-rid=resource =vase]
^- card
=/ =wire
(make-wire /store)
=+ !<(rid=resource (get-conversion vase))
?> =(src.bowl (~(got by tracking) rid))
?> =(wire-rid rid)
=+ resources=(~(gas in *(set resource)) (resource-for-update:og vase))
?> ?| no-validate.config
?& (check-src resources)
(~(has in resources) wire-rid)
== ==
[%pass wire %agent [our.bowl store-name.config] %poke update-mark.config vase]
--
--

View File

@ -67,6 +67,16 @@
|* =config
$_ ^|
|_ bowl:gall
::
:: +resource-for-update: get affected resources from an update
::
:: Given a vase of the update, the mark of which is
:: update-mark.config, produce the affected resources, if any.
::
++ resource-for-update
|~ vase
*(list resource)
::
:: +take-update: handle update from store
::
:: Given an update from the store, do other things after proxying
@ -145,12 +155,12 @@
=* state -
^- agent:gall
=<
|_ =bowl:gall
+* this .
og ~(. push-hook bowl)
hc ~(. +> bowl)
def ~(. (default-agent this %|) bowl)
::
++ on-init
=^ cards push-hook
on-init:og
@ -165,11 +175,9 @@
|^
?- -.old
%1
=. cards
:_(cards (build-mark:hc %sing))
=^ og-cards push-hook
(on-load:og inner-state.old)
[(weld (flop cards) og-cards) this(state old)]
[(weld cards og-cards) this(state old)]
::
%0
%_ $
@ -261,6 +269,7 @@
(push-updates:hc q.cage.sign)
cards
==
::
++ on-leave
|= =path
=^ cards push-hook
@ -269,21 +278,24 @@
::
++ on-arvo
|= [=wire =sign-arvo]
?. ?=([%helper %push-hook @ *] wire)
=^ cards push-hook
(on-arvo:og wire sign-arvo)
[cards this]
?. ?=(%resource-conversion i.t.t.wire)
(on-arvo:def wire sign-arvo)
:_ this
~[(build-mark:hc %next)]
=^ cards push-hook
(on-arvo:og wire sign-arvo)
[cards this]
::
++ on-fail
|= [=term =tang]
=^ cards push-hook
(on-fail:og term tang)
[cards this]
++ on-peek on-peek:og
::
++ on-peek
|= =path
^- (unit (unit cage))
?: =(/x/dbug/state path)
``noun+(slop !>(state(inner-state *vase)) on-save:og)
?. =(/x/sharing path)
(on-peek:og path)
``noun+!>(sharing)
--
|_ =bowl:gall
+* og ~(. push-hook bowl)
@ -306,6 +318,7 @@
%remove (remove +.action)
%revoke (revoke +.action)
==
::
++ add
|= rid=resource
=. sharing
@ -317,7 +330,7 @@
=/ pax=path
[%resource (en-path:resource rid)]
=/ paths=(set path)
%- sy
%- silt
%+ turn
(incoming-subscriptions pax)
|=([ship pox=path] pox)
@ -339,6 +352,7 @@
~
`[%give %kick ~[path] `her]
--
::
++ incoming-subscriptions
|= prefix=path
^- (list (pair ship path))
@ -366,57 +380,50 @@
++ push-updates
|= =vase
^- (list card:agent:gall)
=/ rid=(unit resource)
(resource-for-update vase)
?~ rid ~
=/ rids=(list resource) (resource-for-update vase)
=| cards=(list card:agent:gall)
|-
?~ rids cards
=/ prefix=path
resource+(en-path:resource u.rid)
resource+(en-path:resource i.rids)
=/ paths=(list path)
%~ tap in
%- silt
%+ turn
(incoming-subscriptions prefix)
|=([ship pax=path] pax)
?~ paths ~
[%give %fact paths update-mark.config vase]~
?~ paths $(rids t.rids)
%_ $
rids t.rids
cards (snoc cards [%give %fact paths update-mark.config vase])
==
::
++ forward-update
|= =vase
^- (list card:agent:gall)
=/ rid=(unit resource)
(resource-for-update vase)
?~ rid ~
=/ rids=(list resource) (resource-for-update vase)
=| cards=(list card:agent:gall)
|-
?~ rids cards
=/ =path
resource+(en-path:resource u.rid)
resource+(en-path:resource i.rids)
=/ =wire
(make-wire resource+(en-path:resource u.rid))
(make-wire resource+(en-path:resource i.rids))
=/ dap=term
?:(=(our.bowl entity.u.rid) store-name.config dap.bowl)
[%pass wire %agent [entity.u.rid dap] %poke update-mark.config vase]~
::
++ get-conversion
.^ tube:clay
%cc (scot %p our.bowl) %home (scot %da now.bowl)
/[update-mark.config]/resource
?:(=(our.bowl entity.i.rids) store-name.config dap.bowl)
%_ $
rids t.rids
::
cards
%+ snoc cards
[%pass wire %agent [entity.i.rids dap] %poke update-mark.config vase]
==
::
++ resource-for-update
|= update=vase
=/ =tube:clay
get-conversion
%+ bind
(mole |.((tube update)))
|=(=vase !<(resource vase))
::
++ build-mark
|= rav=?(%sing %next)
^- card
=/ =wire
(make-wire /resource-conversion)
=/ =mood:clay
[%c da+now.bowl /[update-mark.config]/resource]
=/ =rave:clay
?:(?=(%next rav) [rav mood] [rav mood])
[%pass wire %arvo %c %warp our.bowl [%home `rave]]
|= =vase
^- (list resource)
%~ tap in
%- silt
(resource-for-update:og vase)
--
--

132
pkg/arvo/lib/settings.hoon Normal file
View File

@ -0,0 +1,132 @@
/- *settings
|%
++ enjs
=, enjs:format
|%
++ data
|= dat=^data
^- json
%+ frond -.dat
?- -.dat
%all (settings +.dat)
%bucket (bucket +.dat)
%entry (value +.dat)
==
::
++ settings
|= s=^settings
^- json
[%o (~(run by s) bucket)]
::
++ event
|= evt=^event
^- json
%+ frond -.evt
?- -.evt
%put-bucket (put-bucket +.evt)
%del-bucket (del-bucket +.evt)
%put-entry (put-entry +.evt)
%del-entry (del-entry +.evt)
==
::
++ put-bucket
|= [k=key b=^bucket]
^- json
%- pairs
:~ bucket-key+s+k
bucket+(bucket b)
==
::
++ del-bucket
|= k=key
^- json
%- pairs
:~ bucket-key+s+k
==
::
++ put-entry
|= [b=key k=key v=val]
^- json
%- pairs
:~ bucket-key+s+b
entry-key+s+k
value+(val v)
==
::
++ del-entry
|= [buc=key =key]
^- json
%- pairs
:~ bucket-key+s+buc
entry-key+s+key
==
::
++ value
|= =val
^- json
?- -.val
%s val
%b val
%n (numb p.val)
==
::
++ bucket
|= b=^bucket
^- json
[%o (~(run by b) value)]
--
::
++ dejs
=, dejs:format
|%
++ event
|= jon=json
^- ^event
%. jon
%- of
:~ put-bucket+put-bucket
del-bucket+del-bucket
put-entry+put-entry
del-entry+del-entry
==
::
++ put-bucket
%- ot
:~ bucket-key+so
bucket+bucket
==
::
++ del-bucket
%- ot
:~ bucket-key+so
==
::
++ put-entry
%- ot
:~ bucket-key+so
entry-key+so
value+val
==
::
++ del-entry
%- ot
:~ bucket-key+so
entry-key+so
==
::
++ value
|= jon=json
^- val
?+ -.jon !!
%s jon
%b jon
%n [%n (rash p.jon dem)]
==
::
++ bucket
|= jon=json
^- ^bucket
?> ?=([%o *] jon)
(~(run by p.jon) value)
--
--

View File

@ -238,6 +238,13 @@
`[%done ~]
==
::
++ raw-poke-our
|= [app=term =cage]
=/ m (strand ,~)
^- form:m
;< =bowl:spider bind:m get-bowl
(raw-poke [our.bowl app] cage)
::
++ poke-our
|= [=term =cage]
=/ m (strand ,~)

View File

@ -1,15 +0,0 @@
/+ *contact-json
|_ act=contact-action
++ grad %noun
++ grow
|%
++ noun act
--
++ grab
|%
++ noun contact-action
++ json
|= jon=^json
(json-to-action jon)
--
--

View File

@ -1,15 +0,0 @@
/+ *contact-json
|_ upd=contact-hook-update
++ grad %noun
++ grow
|%
++ noun upd
++ json (hook-update-to-json upd)
--
::
++ grab
|%
++ noun contact-hook-update
--
::
--

View File

@ -1,16 +0,0 @@
/+ *contact-json
|_ rolo=rolodex
::
++ grad %noun
++ grow
|%
++ noun +<.grow
++ json (rolodex-to-json rolo)
--
::
++ grab
|%
++ noun rolodex
--
::
--

View File

@ -0,0 +1,15 @@
/+ *contact-store
::
|_ share=[%share =ship]
++ grad %noun
++ grow
|%
++ noun share
--
::
++ grab
|%
+$ noun [%share ship]
++ json share:share-dejs
--
--

View File

@ -1,15 +1,16 @@
/+ *contact-json
|_ upd=contact-update
/+ *contact-store
::
|_ upd=update
++ grad %noun
++ grow
|%
++ noun upd
++ json (update-to-json upd)
++ json (update:enjs upd)
--
::
++ grab
|%
++ noun contact-update
++ noun update
++ json update:dejs
--
::
--

View File

@ -1,12 +0,0 @@
/- *contact-view
|_ act=contact-view-action
++ grad %noun
++ grow
|%
++ noun act
--
++ grab
|%
++ noun contact-view-action
--
--

View File

@ -0,0 +1,12 @@
/- *graph-store
|_ per=permissions
++ grad %noun
++ grow
|%
++ noun per
--
++ grab
|%
++ noun permissions
--
--

View File

@ -0,0 +1,12 @@
/- *graph-store
|_ per=permissions
++ grad %noun
++ grow
|%
++ noun per
--
++ grab
|%
++ noun permissions
--
--

View File

@ -7,13 +7,6 @@
|%
++ noun upd
++ json (update:enjs upd)
++ resource
?+ -.q.upd !!
?(%run-updates %add-nodes %remove-nodes %add-graph) resource.q.upd
?(%remove-graph %archive-graph %unarchive-graph) resource.q.upd
?(%add-tag %remove-tag) resource.q.upd
?(%add-signatures %remove-signatures) resource.uid.q.upd
==
++ mime [/application/x-urb-graph-update (as-octs (jam upd))]
--
::

View File

@ -1,10 +1,22 @@
/- *post
/- *post, met=metadata-store
|_ i=indexed-post
++ grow
|%
++ noun i
::
++ graph-permissions-add
|= vip=vip-metadata:met
?+ index.p.i !!
[@ ~] [%yes %yes %no]
==
::
++ graph-permissions-remove
|= vip=vip-metadata:met
?+ index.p.i !!
[@ ~] [%self %self %no]
==
::
++ notification-kind
::
?+ index.p.i ~
[@ ~] `[%message 0 %count %.n]
==

View File

@ -1,8 +1,29 @@
/- *post
/- *post, met=metadata-store
|_ i=indexed-post
++ grow
|%
++ noun i
::
++ graph-permissions-add
|= vip=vip-metadata:met
=/ reader
?=(%reader-comments vip)
?+ index.p.i !!
[@ ~] [%yes %yes %no]
[@ @ ~] [%yes %yes ?:(reader %yes %no)]
[@ @ @ ~] [%self %self %self]
==
::
++ graph-permissions-remove
|= vip=vip-metadata:met
=/ reader
?=(%reader-comments vip)
?+ index.p.i !!
[@ ~] [%yes %self %self]
[@ @ ~] [%yes %self %self]
[@ @ @ ~] [%yes %self %self]
==
::
++ notification-kind
?+ index.p.i ~
[@ ~] `[%link 0 %each %.y]

View File

@ -1,10 +1,27 @@
/- *post
/- *post, met=metadata-store
|_ i=indexed-post
++ grow
|%
++ noun i
++ graph-permissions-add
|= vip=vip-metadata:met
?+ index.p.i !!
[@ ~] [%yes %yes %no] :: new note
[@ %1 @ ~] [%self %self %no]
[@ %2 @ ~] [%yes %yes ?:(?=(%reader-comments vip) %yes %no)]
[@ %2 @ @ ~] [%self %self %self]
==
::
++ graph-permissions-remove
|= vip=vip-metadata:met
?+ index.p.i !!
[@ ~] [%yes %self %self]
[@ %1 @ @ ~] [%yes %self %self]
[@ %2 @ ~] [%yes %self %self]
[@ %2 @ @ ~] [%yes %self %self]
==
:: +notification-kind
:: Ignore all containers, only notify on content
:: ignore all containers, only notify on content
::
++ notification-kind
?+ index.p.i ~
@ -16,7 +33,7 @@
--
++ grab
|%
:: +noun: Validate publish post
:: +noun: validate publish post
::
++ noun
|= p=*

View File

@ -4,10 +4,6 @@
++ grow
|%
++ noun upd
++ resource
?< ?=(%initial -.upd)
resource.upd
::
++ json
%+ frond:enjs:format 'groupUpdate'
(update:enjs upd)

View File

@ -0,0 +1,13 @@
/+ view=group-view
|_ =action:view
++ grad %noun
++ grow
|%
++ noun action
--
++ grab
|%
++ noun action:view
++ json action:dejs:view
--
--

View File

@ -0,0 +1,13 @@
/+ view=group-view
|_ =update:view
++ grad %noun
++ grow
|%
++ noun update
++ json (update:enjs:view update)
--
++ grab
|%
++ noun update:view
--
--

View File

@ -0,0 +1,10 @@
/- *metadata-hook
|_ act=metadata-hook-action
++ grab |%
++ noun metadata-hook-action
--
++ grow |%
++ noun act
--
++ grad %noun
--

View File

@ -1,16 +1,14 @@
/+ *metadata-json
=, dejs:format
|_ act=metadata-action
/+ store=metadata-store
|_ =action:store
++ grad %noun
++ grow
|%
++ noun act
++ noun action
++ json update:enjs:store
--
++ grab
|%
++ noun metadata-action
++ json
|= jon=^json
(json-to-action jon)
++ noun action:store
++ json action:dejs:store
--
--

View File

@ -0,0 +1,15 @@
/+ store=metadata-store
|_ =hook-update:store
++ grad %noun
++ grow
|%
++ noun hook-update
++ json (hook-update:enjs:store hook-update)
--
::
++ grab
|%
++ noun hook-update:store
--
--

View File

@ -1,15 +1,15 @@
/+ *metadata-json
|_ upd=metadata-update
/+ store=metadata-store
|_ =update:store
++ grad %noun
++ grow
|%
++ noun upd
++ json (update-to-json upd)
++ noun update
++ json (update:enjs:store update)
--
::
++ grab
|%
++ noun metadata-update
++ noun update:store
++ json action:dejs:store
--
::
--

View File

@ -1,12 +1,13 @@
/- *pull-hook
|_ act=action
/+ pull-hook
|_ =action:pull-hook
++ grab
|%
++ noun action
++ noun action:pull-hook
++ json action:dejs:pull-hook
--
++ grow
|%
++ noun act
++ noun action
--
++ grad %noun
--

View File

@ -4,7 +4,9 @@
++ grow
|%
++ noun rid
++ json (enjs:resource rid)
++ json
%+ frond:enjs:format %resource
(enjs:resource rid)
--
++ grab
|%

View File

@ -0,0 +1,13 @@
/+ *settings
|_ dat=data
++ grad %noun
++ grow
|%
++ noun dat
++ json (data:enjs dat)
--
++ grab
|%
++ noun data
--
--

View File

@ -0,0 +1,16 @@
/+ *settings
|_ evt=event
++ grad %noun
++ grow
|%
++ noun evt
++ json
%+ frond:enjs:format %settings-event
(event:enjs evt)
--
++ grab
|%
++ noun event
++ json event:dejs
--
--

12
pkg/arvo/mar/tape.hoon Normal file
View File

@ -0,0 +1,12 @@
|_ tap=tape
++ grad %noun
++ grow
|%
++ noun tap
++ json s+(crip tap)
--
++ grab
|%
++ noun tape
--
--

12
pkg/arvo/mar/woff2.hoon Normal file
View File

@ -0,0 +1,12 @@
|_ dat=octs
++ grow
|%
++ mime [/font/woff2 dat]
--
++ grab
|%
++ mime |=([=mite =octs] octs)
++ noun octs
--
++ grad %mime
--

View File

@ -1,18 +0,0 @@
|%
+$ contact-hook-action
$% :: %add-owned: make a contacts list accessible to foreign ships
:: who are members of that list
::
[%add-owned =path]
:: %add-synced: mirror a foreign contacts list to our contact-store
::
[%add-synced =ship =path]
:: %remove: stop mirroring a foreign contacts list or stop allowing
:: a local contacts list to be mirrored
::
[%remove =path]
==
::
+$ synced (map path ship)
+$ contact-hook-update [%initial =synced]
--

View File

@ -1,43 +1,40 @@
/- *identity
/- *resource
|%
+$ rolodex (map path contacts)
+$ contacts (map ship contact)
+$ avatar
$% [%octt content-type=@t octs=[p=@ud q=@t]]
[%url url=@t]
==
::
+$ rolodex (map ship contact)
+$ contact
$: nickname=@t
email=@t
phone=@t
website=@t
notes=@t
bio=@t
status=@t
color=@ux
avatar=(unit avatar)
avatar=(unit @t)
cover=(unit @t)
groups=(set resource)
last-updated=@da
==
::
+$ edit-field
$% [%nickname nickname=@t]
[%email email=@t]
[%phone phone=@t]
[%website website=@t]
[%notes notes=@t]
[%bio bio=@t]
[%status status=@t]
[%color color=@ux]
[%avatar avatar=(unit avatar)]
[%avatar avatar=(unit @t)]
[%add-group =resource]
[%remove-group =resource]
[%cover cover=(unit @t)]
==
::
+$ contact-action
$% [%create =path]
[%delete =path]
[%add =path =ship =contact]
[%remove =path =ship]
[%edit =path =ship =edit-field]
+$ beings
$% [%ships ships=(set ship)]
[%group =resource]
==
::
+$ contact-update
$% [%initial =rolodex]
[%contacts =path =contacts]
contact-action
+$ update
$% [%initial =rolodex is-public=?]
[%add =ship =contact]
[%remove =ship]
[%edit =ship =edit-field]
[%allow =beings]
[%disallow =beings]
[%set-public public=?]
==
--

View File

@ -1,27 +0,0 @@
/- *contact-store, *group, *resource
::
|%
+$ contact-view-action
$% :: %create: create in both groups and contacts
::
[%create name=term =policy title=@t description=@t]
:: %join: join open group in both groups and contacts
::
[%join =resource]
:: %invite: invite to invite-only group and contacts
::
[%invite =resource =ship text=cord]
:: %remove: remove from both groups and contacts
::
[%remove =path =ship]
:: %delete: delete in both groups and contacts
::
[%delete =path]
:: %share: send %add contact-action to to recipient's contact-hook
::
[%share recipient=ship =path =ship =contact]
:: %groupify: create contacts object for a preexisting group
::
[%groupify =resource title=@t description=@t]
==
--

View File

@ -1,10 +1,29 @@
/- glob
|%
+$ action
$% [%serve-dir url-base=path clay-base=path public=? spa=?]
$% :: %serve-dir: from clay directory
::
:: url-base site path to route from
:: clay-base clay path to route to
:: public if false, require login
:: spa if true, `404` becomes `clay-base/index.html`
::
[%serve-dir url-base=path clay-base=path public=? spa=?]
:: %serve-glob: from glob blobs
::
:: url-base site path to route from
:: glob blobs
:: public if false, require login
::
[%serve-glob url-base=path =glob:glob public=?]
:: %unserve-dir: remove binding on url-base
::
[%unserve-dir url-base=path]
:: %toggle-permission: toggle public flag on url-base
::
[%toggle-permission url-base=path]
:: %set-landscape-homepage-prefix: serve landscape at / or /term
::
[%set-landscape-homepage-prefix prefix=(unit term)]
==
::

View File

@ -1,5 +1,17 @@
/- *post
|%
::
+$ permissions
[admin=permission-level writer=permission-level reader=permission-level]
::
:: $permission-level: levels of permissions in increasing order
::
:: %no: May not add/remove node
:: %self: May only nodes beneath nodes that were added by
:: the same pilot, may remove nodes that the pilot 'owns'
:: %yes: May add a node or remove node
+$ permission-level
?(%no %self %yes)
+$ graph ((mop atom node) gth)
+$ marked-graph [p=graph q=(unit mark)]
::
@ -11,6 +23,7 @@
+$ update-log ((mop time logged-update) gth)
+$ update-logs (map resource update-log)
::
::
+$ internal-graph
$~ [%empty ~]
$% [%graph p=graph]

View File

@ -2,25 +2,6 @@
^?
|%
::
++ state-zero
|%
+$ group (set ship)
::
+$ group-action
$% [%add members=group pax=path] :: add member to group
[%remove members=group pax=path] :: remove member from group
[%bundle pax=path] :: create group at path
[%unbundle pax=path] :: delete group at path
==
::
+$ group-update
$% [%keys keys=(set path)] :: keys have changed
[%path members=group pax=path]
group-action
==
::
+$ groups (map path group)
--
:: $action: request to change group-store state
::
:: %add-group: add a group

View File

@ -0,0 +1,27 @@
/- *resource, *group
^?
|%
::
+$ action
$% :: host side
[%create name=term =policy title=@t description=@t]
[%remove =resource]
:: client side
[%join =resource =ship]
[%leave =resource]
::
[%invite =resource ships=(set ship) description=@t]
==
::
+$ progress
?(%start %added final)
::
+$ final
?(%no-perms %strange %done)
::
+$ update
$% [%initial initial=(map resource progress)]
[%progress =resource =progress]
==
--

View File

@ -2,6 +2,22 @@
::
^?
|%
::
++ groups-state-one
|%
+$ groups (map resource group)
::
+$ tag $@(group-tag [app=term tag=term])
::
+$ tags (jug tag ship)
::
+$ group
$: members=(set ship)
=tags
=policy
hidden=?
==
--
:: $groups: a mapping from group-ids to groups
::
+$ groups (map resource group)
@ -16,7 +32,7 @@
:: Tags may be used and recognised differently across apps.
:: for example, you could use tags like `%author`, `%bot`, `%flagged`...
::
+$ tag $@(group-tag [app=term tag=term])
+$ tag $@(group-tag [app=term =resource tag=term])
:: $role-tag: a kind of $group-tag that identifies a privileged user
::
:: These roles are

View File

@ -25,6 +25,13 @@
[%chat chat=path mention=?]
==
::
+$ group-contents
$~ [%add-members *resource ~]
$% [%add *]
[%remove *] :: old metadata actions
$>(?(%add-members %remove-members) update:group-store)
==
::
+$ contents
$% [%graph =(list post:post)]
[%group =(list group-contents)]
@ -42,11 +49,45 @@
unreads-each=(jug index index:graph-store)
unreads-count=(map index @ud)
last-seen=(map index @da)
=notifications:state-two
archive=notifications:state-two
current-timebox=@da
dnd=_|
==
--
++ state-two
=< state
|%
+$ state
$: unreads-each=(jug stats-index index:graph-store)
unreads-count=(map stats-index @ud)
last-seen=(map stats-index @da)
=notifications
archive=notifications
current-timebox=@da
dnd=_|
==
::
++ orm
((ordered-map @da timebox) gth)
::
+$ notification
[date=@da read=? =contents]
::
+$ contents
$% [%graph =(list post:post)]
[%group =(list group-contents)]
==
::
+$ group-contents
group-contents:state-zero
::
+$ timebox
(map index notification)
::
+$ notifications
((mop @da timebox) gth)
::
--
::
+$ index
@ -62,9 +103,7 @@
::
+$ group-contents
$~ [%add-members *resource ~]
$% $>(?(%add-members %remove-members) update:group-store)
metadata-action:metadata-store
==
$>(?(%add-members %remove-members) update:group-store)
::
+$ notification
[date=@da read=? =contents]

View File

@ -1,28 +1,64 @@
/- *resource
^?
|%
+$ group-path path
::
+$ app-name term
+$ app-path path
+$ md-resource [=app-name =app-path]
+$ associations (map [group-path md-resource] metadata)
+$ md-resource [=app-name =resource]
+$ association [group=resource =metadatum]
+$ associations (map md-resource association)
+$ group-preview
$: group=resource
channels=associations
members=@ud
channel-count=@ud
=metadatum
==
::
+$ color @ux
+$ metadata
+$ url @t
::
:: $vip-metadata: variation in permissions
::
:: This will be passed to the graph-permissions mark
:: conversion to allow for custom permissions.
::
:: %reader-comments: Allow readers to comment, regardless
:: of whether they can write. (notebook, collections)
:: %member-metadata: Allow members to add channels (groups)
:: %$: No variation
::
+$ vip-metadata ?(%reader-comments %member-metadata %$)
+$ metadatum
$: title=cord
description=cord
=color
date-created=time
creator=ship
module=term
picture=url
preview=?
vip=vip-metadata
==
::
+$ metadata-action
$% [%add =group-path resource=md-resource =metadata]
[%remove =group-path resource=md-resource]
+$ action
$% [%add group=resource resource=md-resource =metadatum]
[%remove group=resource resource=md-resource]
[%initial-group group=resource =associations]
==
::
+$ metadata-update
$% metadata-action
+$ hook-update
$% [%req-preview group=resource]
[%preview group-preview]
==
::
+$ update
$% action
[%associations =associations]
[%update-metadata =group-path resource=md-resource =metadata]
$: %updated-metadata
group=resource
resource=md-resource
before=metadatum
=metadatum
==
==
--

View File

@ -0,0 +1,21 @@
|%
+$ settings (map key bucket)
+$ bucket (map key val)
+$ key term
+$ val
$% [%s p=@t]
[%b p=?]
[%n p=@]
==
+$ event
$% [%put-bucket =key =bucket]
[%del-bucket =key]
[%put-entry buc=key =key =val]
[%del-entry buc=key =key]
==
+$ data
$% [%all =settings]
[%bucket =bucket]
[%entry =val]
==
--

13
pkg/arvo/ted/code.hoon Normal file
View File

@ -0,0 +1,13 @@
/- spider
/+ strandio
=, strand=strand:spider
^- thread:spider
|= arg=vase
=/ m (strand ,vase)
^- form:m
;< =bowl:spider bind:m get-bowl:strandio
;< code=@p bind:m (scry:strandio @p /j/code/(scot %p our.bowl))
%- pure:m
!> ^- tape
%+ slag 1
(scow %p code)

View File

@ -1,9 +1,10 @@
/- spider,
graph=graph-store,
*metadata-store,
met=metadata-store,
*group,
group-store,
inv=invite-store
inv=invite-store,
push-hook
/+ strandio, resource, graph-view
=>
|%
@ -16,13 +17,22 @@
=/ m (strand ,resource)
?: ?=(%group -.associated)
(pure:m rid.associated)
=/ =action:group-store
[%add-group rid policy.associated %&]
;< ~ bind:m (poke-our %group-store %group-action !>(action))
;< =bowl:spider bind:m get-bowl:strandio
;< ~ bind:m (poke-our %group-store %group-action !>([%add-members rid (sy our.bowl ~)]))
=/ push-hook-act=cage
:- %push-hook-action
!> ^- action:push-hook
[%add rid]
;< ~ bind:m
(poke-our %metadata-push-hook push-hook-act)
;< ~ bind:m
(poke-our %group-push-hook %push-hook-action !>([%add rid]))
%+ poke-our %group-store
:- %group-update
!> ^- update:group-store
[%add-group rid policy.associated %.y]
;< =bowl:spider bind:m get-bowl:strandio
;< ~ bind:m
(poke-our %group-store group-update+!>([%add-members rid (sy our.bowl ~)]))
;< ~ bind:m
(poke-our %group-push-hook push-hook-act)
(pure:m rid)
--
::
@ -52,25 +62,22 @@
::
;< group=resource bind:m
(handle-group rid.action associated.action)
=/ group-path=path
(en-path:resource group)
::
:: Setup metadata
::
=/ =metadata
%* . *metadata
=/ =metadatum:met
%* . *metadatum:met
title title.action
description description.action
date-created now.bowl
creator our.bowl
module module.action
preview %.n
==
=/ =metadata-action
[%add group-path graph+(en-path:resource rid.action) metadata]
=/ met-action=action:met
[%add group graph+rid.action metadatum]
;< ~ bind:m
(poke-our %metadata-hook %metadata-action !>(metadata-action))
;< ~ bind:m
(poke-our %metadata-hook %metadata-hook-action !>([%add-owned group-path]))
(poke-our %metadata-push-hook metadata-update+!>(met-action))
::
:: Send invites
::

View File

@ -1,4 +1,4 @@
/- spider, graph-view, graph=graph-store, *metadata-store, *group
/- spider, graph-view, graph=graph-store, metadata=metadata-store, *group, group-store
/+ strandio, resource
=>
|%
@ -8,17 +8,15 @@
::
++ scry-metadata
|= rid=resource
=/ m (strand ,(unit resource))
;< paxs=(unit (set path)) bind:m
%+ scry:strandio ,(unit (set path))
=/ m (strand ,resource)
;< group=(unit resource) bind:m
%+ scry:strandio ,(unit resource)
;: weld
/gx/metadata-store/resource/graph
(en-path:resource rid)
/noun
==
?~ paxs (pure:m ~)
?~ u.paxs (pure:m ~)
(pure:m `(de-path:resource n.u.paxs))
(pure:m (need group))
::
++ scry-group
|= rid=resource
@ -42,12 +40,33 @@
;< ~ bind:m
(poke-our %graph-push-hook %push-hook-action !>([%remove rid]))
;< ~ bind:m
%+ poke-our %metadata-hook
:- %metadata-action
!> :+ %remove
(en-path:resource group-rid)
[%graph (en-path:resource rid)]
%+ poke-our %metadata-push-hook
:- %metadata-update
!> ^- action:metadata
[%remove group-rid [%graph rid]]
(pure:m ~)
::
++ delete-tags
|= [graph=resource grp-rid=resource =group]
=/ m (strand ,~)
^- form:m
=/ tags=(list [=tag tagged=(set ship)])
%+ skim ~(tap by tags.group)
|= [=tag tagged=(set ship)]
?@ tag %.n
?& =(app.tag %graph)
=(resource.tag graph)
==
|- =* loop $
^- form:m
?~ tags
(pure:m ~)
;< ~ bind:m
%+ poke [entity.grp-rid %group-push-hook]
:- %group-update
!> ^- update:group-store
[%remove-tag grp-rid tag.i.tags tagged.i.tags]
loop(tags t.tags)
--
::
^- thread:spider
@ -59,21 +78,17 @@
;< =bowl:spider bind:m get-bowl:strandio
?. =(our.bowl entity.rid.action)
(strand-fail:strandio %bad-request ~)
;< ugroup-rid=(unit resource) bind:m
;< group-rid=resource bind:m
(scry-metadata rid.action)
?~ ugroup-rid !!
;< =group bind:m
(scry-group u.ugroup-rid)
(scry-group group-rid)
;< ~ bind:m
(delete-tags rid.action group-rid group)
;< ~ bind:m
(delete-graph group-rid rid.action)
?. hidden.group
;< ~ bind:m
(delete-graph u.ugroup-rid rid.action)
(pure:m !>(~))
;< ~ bind:m
(poke-our %group-store %group-action !>([%remove-group rid.action ~]))
;< ~ bind:m
(poke-our %group-push-hook %push-hook-action !>([%remove rid.action]))
;< ~ bind:m (delete-graph u.ugroup-rid rid.action)
;< ~ bind:m
%+ poke-our %metadata-hook
metadata-hook-action+!>([%remove (en-path:resource u.ugroup-rid)])
;< =thread-result:strandio bind:m
(await-thread:strandio %group-delete !>(`[%remove rid.action]))
(pure:m !>(~))

View File

@ -11,53 +11,14 @@
|= rid=resource
=/ m (strand ,(unit resource))
^- form:m
;< pax=(unit (set path)) bind:m
%+ scry:strandio ,(unit (set path))
;< res=(unit resource) bind:m
%+ scry:strandio ,(unit resource)
;: weld
/gx/metadata-store/resource/graph
(en-path:resource rid)
/noun
==
%- pure:m
?~ pax ~
?~ u.pax ~
`(de-path:resource n.u.pax)
::
++ wait-for-group-join
|= rid=resource
=/ m (strand ,~)
^- form:m
=/ pax
(en-path:resource rid)
=/ hold=@dr ~s0..8000
|- ^- form:m
?> (lte hold ~m5)
=* loop $
;< u-group=(unit group) bind:m
(scry:strandio ,(unit group) (weld /gx/group-store/groups (snoc pax %noun)))
?^ u-group
(pure:m ~)
;< ~ bind:m (sleep:strandio hold)
=. hold (mul hold 2)
loop
::
++ wait-for-md
|= rid=resource
=/ m (strand ,~)
^- form:m
=/ pax
(en-path:resource rid)
=/ hold=@dr ~s0..8000
|- ^- form:m
?> (lte hold ~m5)
=* loop $
;< groups=(jug path md-resource) bind:m
(scry:strandio ,(jug path md-resource) /gy/metadata-store/group-indices)
?: (~(has by groups) pax)
(pure:m ~)
;< ~ bind:m (sleep:strandio hold)
=. hold (mul hold 2)
loop
(pure:m res)
--
::
^- thread:spider
@ -70,31 +31,10 @@
?: =(our.bowl entity.rid.action)
(fail %bad-request ~)
;< group=(unit resource) bind:m (scry-metadata rid.action)
?^ group
:: We have group, graph is managed
;< ~ bind:m
%+ poke-our %graph-pull-hook
pull-hook-action+!>([%add ship.action rid.action])
(pure:m !>(~))
:: Else, add group then join
?> ?=(^ group)
:: We have group, graph is managed
;< ~ bind:m
%+ (map-err:strandio ,~) |=(* [%forbidden ~])
%+ poke
[ship.action %group-push-hook]
group-update+!>([%add-members rid.action (sy our.bowl ~)])
::
;< ~ bind:m
%+ poke-our %group-pull-hook
pull-hook-action+!>([%add ship.action rid.action])
;< ~ bind:m (wait-for-group-join rid.action)
::
;< ~ bind:m
%+ poke-our %metadata-hook
metadata-hook-action+!>([%add-synced ship.action (en-path:resource rid.action)])
::
;< ~ bind:m (wait-for-md rid.action)
::
;< ~ bind:m
%+ poke-our %graph-pull-hook
pull-hook-action+!>([%add ship.action rid.action])
%+ poke-our %graph-pull-hook
pull-hook-action+!>([%add ship.action rid.action])
(pure:m !>(~))

View File

@ -10,16 +10,14 @@
|= rid=resource
=/ m (strand ,resource)
^- form:m
;< pax=(unit (set path)) bind:m
%+ scry:strandio ,(unit (set path))
;< group=(unit resource) bind:m
%+ scry:strandio ,(unit resource)
;: weld
/gx/metadata-store/resource/graph
(en-path:resource rid)
/noun
==
?> ?=(^ pax)
?> ?=(^ u.pax)
(pure:m (de-path:resource n.u.pax))
(pure:m (need group))
::
++ scry-group
|= rid=resource
@ -56,21 +54,9 @@
(strand-fail:strandio %bad-request ~)
;< group-rid=resource bind:m (scry-metadata rid.action)
;< g=group bind:m (scry-group group-rid)
?. hidden.g
;< ~ bind:m (delete-graph now.bowl rid.action)
(pure:m !>(~))
;< ~ bind:m
%+ poke-our %metadata-hook
metadata-hook-action+!>([%remove (en-path:resource rid.action)])
;< ~ bind:m
%+ poke-our %metadata-store
:- %metadata-action
!> :+ %remove
(en-path:resource rid.action)
[%graph (en-path:resource rid.action)]
;< ~ bind:m
(poke-our %group-store %group-action !>([%remove-group rid.action ~]))
;< ~ bind:m
(poke-our %group-pull-hook %pull-hook-action !>([%remove rid.action]))
;< ~ bind:m (delete-graph now.bowl rid.action)
?. hidden.g
(pure:m !>(~))
;< =thread-result:strandio bind:m
(await-thread:strandio %group-leave !>([~ [%leave rid.action]]))
(pure:m !>(~))

Some files were not shown because too many files have changed in this diff Show More