Merge branch 'release/next-userspace' into la/group-feed

This commit is contained in:
Logan Allen 2021-03-23 21:13:12 -05:00
commit 9de66bc5af
84 changed files with 1369 additions and 369 deletions

View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1
oid sha256:bb221ce7316346bfaf1ddd953927c0f2afe7eaf5b160bed545f67ec7e5ccb005
size 9410487
oid sha256:a8b19cbe89f770f8d6c1e05972be7a3a01545b93b0f2d4523809e7df18635f3c
size 9462938

View File

@ -169,7 +169,7 @@
::
%fact
?+ p.cage.sign ~|([dap.bowl %bad-sub-mark wire p.cage.sign] !!)
%graph-update
%graph-update-0
%- on-graph-update:tc
!<(update:graph q.cage.sign)
==
@ -758,7 +758,7 @@
::TODO move creation into lib?
%^ act %out-message
%graph-push-hook
:- %graph-update
:- %graph-update-0
!> ^- update:graph
:+ %0 now.bowl
:+ %add-nodes audience

View File

@ -154,7 +154,7 @@
++ poke-graph-store
|= =update:graph-store
^- card
(poke-our %graph-store %graph-update !>(update))
(poke-our %graph-store %graph-update-0 !>(update))
::
++ nobody
^- @p

View File

@ -293,12 +293,12 @@
|= group=resource
^- card
=- [%pass / %agent [our.bol %group-store] %poke -]
group-update+!>([%remove-group group ~])
group-update-0+!>([%remove-group group ~])
::
++ poke-graph-store
|= =update:graph-store
^- card
[%pass / %agent [our.bol %graph-store] %poke %graph-update !>(update)]
[%pass / %agent [our.bol %graph-store] %poke %graph-update-0 !>(update)]
::
++ letter-to-contents
|= =letter:store

View File

@ -10,6 +10,7 @@
update:store
%contact-update
%contact-push-hook
0 0
%.y :: necessary to enable p2p
==
--

View File

@ -11,6 +11,7 @@
update:store
%contact-update
%contact-pull-hook
0 0
==
::
+$ agent (push-hook:push-hook config)

View File

@ -71,7 +71,7 @@
++ give
|= =update:store
^- (list card)
[%give %fact ~ [%contact-update !>(update)]]~
[%give %fact ~ [%contact-update-0 !>(update)]]~
--
::
++ on-poke
@ -81,7 +81,7 @@
|^
=^ cards state
?+ mark (on-poke:def mark vase)
%contact-update (update !<(update:store vase))
%contact-update-0 (update !<(update:store vase))
%import (import q.vase)
==
[cards this]
@ -203,7 +203,7 @@
?: our
[/updates /our /all ~]
[/updates /all ~]
[%give %fact paths %contact-update !>(update)]~
[%give %fact paths %contact-update-0 !>(update)]~
--
::
++ import
@ -223,7 +223,7 @@
=/ =ship (slav %p i.t.t.path)
=/ contact=(unit contact:store) (~(get by rolodex) ship)
?~ contact [~ ~]
:- ~ :- ~ :- %contact-update
:- ~ :- ~ :- %contact-update-0
!> ^- update:store
[%add ship u.contact]
::

View File

@ -0,0 +1,60 @@
/- store=demo
/+ default-agent, verb, dbug, pull-hook, agentio, resource
~% %demo-pull-hook-top ..part ~
|%
+$ card card:agent:gall
::
++ config
^- config:pull-hook
:* %demo-store
update:store
%demo-update
%demo-push-hook
:: do not change spacing, required by tests
0
0
%.n
==
::
--
::
::
%- 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)
::
++ on-init on-init:def
++ on-save !>(~)
++ on-load on-load:def
++ on-poke on-poke:def
++ on-agent on-agent:def
++ on-watch on-watch:def
++ on-leave on-leave:def
++ on-peek on-peek:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
++ on-pull-nack
|= [=resource =tang]
^- (quip card _this)
~& "{<resource>}: nacked"
%- (slog tang)
`this
::
++ on-pull-kick
|= =resource
^- (unit path)
~& "{<resource>}: kicked"
`/
::
++ resource-for-update
|= =vase
=+ !<(=update:store vase)
~[p.update]
--

View File

@ -0,0 +1,65 @@
/- store=demo
/+ default-agent, verb, dbug, push-hook, resource, agentio
|%
+$ card card:agent:gall
::
++ config
^- config:push-hook
:* %demo-store
/updates
update:store
%demo-update
%demo-pull-hook
::
0
0
==
::
+$ 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)
io ~(. agentio bowl)
::
++ on-init on-init:def
++ on-save !>(~)
++ on-load on-load:def
++ on-poke on-poke:def
++ on-agent on-agent:def
++ on-watch on-watch:def
++ on-leave on-leave:def
++ on-peek on-peek:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
::
++ transform-proxy-update
|= vas=vase
^- (unit vase)
`vas
::
++ resource-for-update
|= =vase
=+ !<(=update:store vase)
~[p.update]
::
++ take-update
|= =vase
^- [(list card) agent]
`this
::
++ initial-watch
|= [=path rid=resource]
^- vase
=+ .^(=update:store %gx (scry:io %demo-store (snoc `^path`log+(en-path:resource rid) %noun)))
!>(update)
::
--

View File

@ -0,0 +1,100 @@
/- store=demo
/+ default-agent, verb, dbug, resource, agentio
|%
+$ card card:agent:gall
+$ state-0
[%0 log=(jar resource update:store) counters=(map resource @ud)]
--
=| state-0
=* state -
::
%- agent:dbug
%+ verb |
^- agent:gall
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
io ~(. agentio bowl)
++ on-init
`this
::
++ on-save
!>(state)
::
++ on-load
|= =vase
=+ !<(old=state-0 vase)
`this(state old)
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
?. =(%demo-update-0 mark)
(on-poke:def mark vase)
~& mark
=+ !<(=update:store vase)
|^
=. log
(~(add ja log) p.update update)
=^ cards state
(upd update)
[cards this]
::
++ upd
|= up=update:store
^- (quip card _state)
?- -.up
%ini (upd-ini +.up)
%add (upd-add +.up)
%sub (upd-sub +.up)
%run (upd-run +.up)
==
::
++ upd-ini
|= [rid=resource ~]
:- (fact:io mark^!>([%ini +<]) /updates ~)^~
state(counters (~(put by counters) rid 0))
::
++ upd-add
|= [rid=resource count=@ud]
:- (fact:io mark^!>([%add +<]) /updates ~)^~
state(counters (~(jab by counters) rid (cury add count)))
::
++ upd-sub
|= [rid=resource count=@ud]
:- (fact:io mark^!>([%sub +<]) /updates ~)^~
state(counters (~(jab by counters) rid (cury sub count)))
::
++ upd-run
=| cards=(list card)
|= [rid=resource =(list update:store)]
?~ list [cards state]
=^ caz state
(upd i.list)
$(list t.list, cards (weld cards caz))
--
::
++ on-watch
|= =path
?. ?=([%updates ~] path)
(on-watch:def path)
`this
::
++ on-peek
|= =path
?. ?=([%x %log @ @ @ ~] path)
(on-peek:def path)
=/ rid=resource
(de-path:resource t.t.path)
=/ =update:store
[%run rid (flop (~(get ja log) rid))]
``noun+!>(update)
::
++ on-agent on-agent:def
::
++ on-arvo on-arvo:def
::
++ on-leave on-leave:def
::
++ on-fail on-fail:def
--

View File

@ -9,6 +9,7 @@
update:store
%graph-update
%graph-push-hook
0 0
%.n
==
--
@ -40,7 +41,7 @@
%- (slog leaf+"nacked {<resource>}" tang)
:_ this
?. (~(has in get-keys:gra) resource) ~
=- [%pass /pull-nack %agent [our.bowl %graph-store] %poke %graph-update -]~
=- [%pass /pull-nack %agent [our.bowl %graph-store] %poke %graph-update-0 -]~
!> ^- update:store
[%0 now.bowl [%archive-graph resource]]
::

View File

@ -12,6 +12,7 @@
update:store
%graph-update
%graph-pull-hook
0 0
==
::
+$ agent (push-hook:push-hook config)

View File

@ -207,7 +207,7 @@
++ give
|= =update-0:store
^- (list card)
[%give %fact ~ [%graph-update !>([%0 now.bowl update-0])]]~
[%give %fact ~ [%graph-update-0 !>([%0 now.bowl update-0])]]~
--
::
++ on-poke
@ -218,7 +218,7 @@
?> (team:title our.bowl src.bowl)
=^ cards state
?+ mark (on-poke:def mark vase)
%graph-update (graph-update !<(update:store vase))
%graph-update-0 (graph-update !<(update:store vase))
%noun (debug !<(debug-input vase))
%import (poke-import q.vase)
==
@ -646,7 +646,7 @@
[cards state]
=* update upd.i.updates
=^ crds state
%- graph-update
%- graph-update
^- update:store
?- -.q.update
%add-graph update(resource.q resource)
@ -660,7 +660,7 @@
++ give
|= [paths=(list path) update=update-0:store]
^- (list card)
[%give %fact paths [%graph-update !>([%0 now.bowl update])]]~
[%give %fact paths [%graph-update-0 !>([%0 now.bowl update])]]~
--
::
++ debug
@ -862,15 +862,15 @@
``noun+!>(q.u.result)
::
[%x %keys ~]
:- ~ :- ~ :- %graph-update
:- ~ :- ~ :- %graph-update-0
!>(`update:store`[%0 now.bowl [%keys ~(key by graphs)]])
::
[%x %tags ~]
:- ~ :- ~ :- %graph-update
:- ~ :- ~ :- %graph-update-0
!>(`update:store`[%0 now.bowl [%tags ~(key by tag-queries)]])
::
[%x %tag-queries ~]
:- ~ :- ~ :- %graph-update
:- ~ :- ~ :- %graph-update-0
!>(`update:store`[%0 now.bowl [%tag-queries tag-queries]])
::
[%x %graph @ @ ~]
@ -879,7 +879,7 @@
=/ result=(unit marked-graph:store)
(~(get by graphs) [ship term])
?~ result [~ ~]
:- ~ :- ~ :- %graph-update
:- ~ :- ~ :- %graph-update-0
!> ^- update:store
:+ %0
now.bowl
@ -895,7 +895,7 @@
?~ result
~& no-archived-graph+[ship term]
[~ ~]
:- ~ :- ~ :- %graph-update
:- ~ :- ~ :- %graph-update-0
!> ^- update:store
:+ %0
now.bowl
@ -912,7 +912,7 @@
=/ graph=(unit marked-graph:store)
(~(get by graphs) [ship term])
?~ graph [~ ~]
:- ~ :- ~ :- %graph-update
:- ~ :- ~ :- %graph-update-0
!> ^- update:store
:+ %0 now.bowl
:+ %add-nodes
@ -939,7 +939,7 @@
(turn t.t.t.t.path (cury slav %ud))
=/ node=(unit node:store) (get-node ship term index)
?~ node [~ ~]
:- ~ :- ~ :- %graph-update
:- ~ :- ~ :- %graph-update-0
!> ^- update:store
:+ %0
now.bowl
@ -959,7 +959,7 @@
=/ graph
(get-node-children ship term parent)
?~ graph [~ ~]
:- ~ :- ~ :- %graph-update
:- ~ :- ~ :- %graph-update-0
!> ^- update:store
:+ %0
now.bowl
@ -990,7 +990,7 @@
=/ children
(get-node-children ship term index)
?~ children [~ ~]
:- ~ :- ~ :- %graph-update
:- ~ :- ~ :- %graph-update-0
!> ^- update:store
:+ %0
now.bowl
@ -1017,7 +1017,7 @@
?- -.children.u.node
%empty [~ ~]
%graph
:- ~ :- ~ :- %graph-update
:- ~ :- ~ :- %graph-update-0
!> ^- update:store
:+ %0
now.bowl

View File

@ -14,6 +14,7 @@
update:store
%group-update
%group-push-hook
0 0
%.n
==
::
@ -44,9 +45,10 @@
++ on-pull-nack
|= [=resource =tang]
^- (quip card _this)
%- (slog tang)
:_ this
=- [%pass / %agent [our.bowl %group-store] %poke -]~
group-update+!>([%remove-group resource ~])
group-update-0+!>([%remove-group resource ~])
::
++ on-pull-kick
|= =resource

View File

@ -17,6 +17,7 @@
update:store
%group-update
%group-pull-hook
0 0
==
::
+$ agent (push-hook:push-hook config)
@ -85,7 +86,7 @@
++ poke-store
|= =update:store
^- card
=+ group-update+!>(update)
=+ group-update-0+!>(update)
[%pass /sane %agent [our.bowl %group-store] %poke -]
::
++ get-subscribers-for-group

View File

@ -113,7 +113,7 @@
?+ mark (on-poke:def mark vase)
%sane (poke-sane:gc !<(?(%check %fix) vase))
::
?(%group-update %group-action)
?(%group-update-0 %group-action)
(poke-group-update:gc !<(update:store vase))
::
%import
@ -127,7 +127,7 @@
?> (team:title our.bowl src.bowl)
?> ?=([%groups ~] path)
:_ this
[%give %fact ~ %group-update !>([%initial groups])]~
[%give %fact ~ %group-update-0 !>([%initial groups])]~
::
++ on-leave on-leave:def
::
@ -234,8 +234,8 @@
sane+(en-path:resource rid)
=* poke-self ~(poke-self pass:io wire)
%+ weld out
:~ (poke-self group-update+!>([%add-members rid (silt our.bol ~)]))
(poke-self group-update+!>([%add-tag rid %admin (silt our.bol ~)]))
:~ (poke-self group-update-0+!>([%add-members rid (silt our.bol ~)]))
(poke-self group-update-0+!>([%add-tag rid %admin (silt our.bol ~)]))
==
::
++ poke-import
@ -298,7 +298,7 @@
|= [rid=resource nack-count=@ud]
^- card
=/ =cage
:- %group-update
:- %group-update-0
!> ^- update:store
[%add-members rid (sy our.bol ~)]
=/ =wire
@ -583,6 +583,6 @@
++ send-diff
|= =update:store
^- (list card)
[%give %fact ~[/groups] %group-update !>(update)]~
[%give %fact ~[/groups] %group-update-0 !>(update)]~
::
--

View File

@ -198,7 +198,7 @@
%- emit
%+ poke:(jn-pass-io /add)
[ship %group-push-hook]
group-update+!>([%add-members rid (silt our.bowl ~)])
group-update-0+!>([%add-members rid (silt our.bowl ~)])
=. jn-core (tx-progress %start)
=> watch-md
watch-groups
@ -259,7 +259,7 @@
::
++ groups-fact
|= =cage
?. ?=(%group-update p.cage) jn-core
?. ?=(%group-update-0 p.cage) jn-core
=+ !<(=update:group-store q.cage)
?. ?=(%initial-group -.update) jn-core
?. =(rid resource.update) jn-core
@ -278,7 +278,7 @@
::
++ md-fact
|= [=mark =vase]
?. ?=(%metadata-update mark) jn-core
?. ?=(%metadata-update-0 mark) jn-core
=+ !<(=update:metadata vase)
?. ?=(%initial-group -.update) jn-core
?. =(group.update rid) jn-core

View File

@ -182,7 +182,7 @@
~[watch-graph:ha]
::
%fact
?. ?=(%graph-update p.cage.sign)
?. ?=(%graph-update-0 p.cage.sign)
(on-agent:def wire sign)
=^ cards state
(graph-update !<(update:graph-store q.cage.sign))

View File

@ -108,12 +108,12 @@
::
%fact
?+ p.cage.sign (on-agent:def wire sign)
%group-update
%group-update-0
=^ cards state
(group-update !<(update:group-store q.cage.sign))
[cards this]
::
%metadata-update
%metadata-update-0
=^ cards state
(metadata-update !<(update:metadata q.cage.sign))
[cards this]

View File

@ -15,6 +15,7 @@
update:metadata
%metadata-update
%metadata-push-hook
0 0
%.n
==
+$ state-zero
@ -82,7 +83,7 @@
%kick [~[watch-contacts] state]
::
%fact
?> ?=(%contact-update p.cage.sign)
?> ?=(%contact-update-0 p.cage.sign)
=+ !<(=update:contact q.cage.sign)
?+ -.update `state
%add
@ -151,7 +152,7 @@
%kick [watch-store^~ state]
::
%fact
?> ?=(%metadata-update p.cage.sign)
?> ?=(%metadata-update-0 p.cage.sign)
=+ !<(=update:metadata q.cage.sign)
?. ?=(%initial-group -.update) `state
`state(previews (~(del by previews) group.update))
@ -255,7 +256,7 @@
%+ turn ~(tap by associations)
|= [=md-resource:metadata =association:metadata]
%+ poke-our:pass:io %metadata-store
:- %metadata-update
:- %metadata-update-0
!> ^- update:metadata
[%remove resource md-resource]
::

View File

@ -14,6 +14,7 @@
update:store
%metadata-update
%metadata-pull-hook
0 0
==
::
+$ agent (push-hook:push-hook config)
@ -65,7 +66,7 @@
=/ role=(unit (unit role-tag))
(role-for-ship:grp group.update src.bowl)
=/ =metadatum:store
(need (peek-metadatum:met %groups group.update))
(fall (peek-metadatum:met %groups group.update) *metadatum:store)
?~ role ~
?^ u.role
?: ?=(?(%admin %moderator) u.u.role)

View File

@ -148,7 +148,7 @@
?> (team:title our.bowl src.bowl)
=^ cards state
?+ mark (on-poke:def mark vase)
?(%metadata-action %metadata-update)
?(%metadata-action %metadata-update-0)
(poke-metadata-update:mc !<(update:store vase))
::
%import
@ -166,7 +166,7 @@
=/ cards=(list card)
?+ path (on-watch:def path)
[%all ~]
(give %metadata-update !>([%associations associations]))
(give %metadata-update-0 !>([%associations associations]))
::
[%updates ~]
~
@ -174,7 +174,7 @@
[%app-name @ ~]
=/ =app-name:store i.t.path
=/ app-indices (metadata-for-app:mc app-name)
(give %metadata-update !>([%associations app-indices]))
(give %metadata-update-0 !>([%associations app-indices]))
==
[cards this]
::
@ -485,6 +485,6 @@
++ update-subscribers
|= [pax=path =update:store]
^- (list card)
[%give %fact ~[pax] %metadata-update !>(update)]~
[%give %fact ~[pax] %metadata-update-0 !>(update)]~
--
--

View File

@ -0,0 +1,8 @@
/- *demo
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[ver=@ud =term count=@ud ~] ~]
==
:- (cat 3 %demo-update- (scot %ud ver))
^- update
[%add [p.beak term] count]

View File

@ -0,0 +1,8 @@
/- *demo
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[=term ~] ~]
==
:- %demo-update-0
^- update
[%ini [p.beak term] ~]

View File

@ -0,0 +1,8 @@
/- *demo
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[=term lst=(list update) ~] ~]
==
:- %demo-update-0
^- update
[%run [p.beak term] lst]

View File

@ -0,0 +1,8 @@
/- *demo
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[=term count=@ud ~] ~]
==
:- %demo-update-0
^- update
[%sub [p.beak term] count]

View File

@ -5,6 +5,6 @@
|= $: [now=@da eny=@uvJ =beak]
[[=resource mark=(unit mark) overwrite=? ~] ~]
==
:- %graph-update
:- %graph-update-0
^- update
[%0 now [%add-graph resource (gas:orm ~ ~) mark overwrite]]

View File

@ -12,7 +12,7 @@
contents.post contents
==
::
:- %graph-update
:- %graph-update-0
^- update
:+ %0 now
:+ %add-nodes [our name]

View File

@ -5,6 +5,6 @@
|= $: [now=@da eny=@uvJ =beak]
[[[=resource =index] =signatures ~] ~]
==
:- %graph-update
:- %graph-update-0
^- update
[%0 now [%add-signatures [resource index] signatures]]

View File

@ -5,6 +5,6 @@
|= $: [now=@da eny=@uvJ =beak]
[[=term =resource ~] ~]
==
:- %graph-update
:- %graph-update-0
^- update
[%0 now [%add-tag term resource]]

View File

@ -5,6 +5,6 @@
|= $: [now=@da eny=@uvJ =beak]
[[=resource ~] ~]
==
:- %graph-update
:- %graph-update-0
^- update
[%0 now [%archive-graph resource]]

View File

@ -4,7 +4,7 @@
|= $: [now=@da eny=@uvJ bec=beak]
[[=ship graph=term ~] ~]
==
:- %graph-update
:- %graph-update-0
=/ our (scot %p p.bec)
=/ wen (scot %da now)
=/ who (scot %p ship)

View File

@ -4,6 +4,6 @@
|= $: [now=@da eny=@uvJ bec=beak]
[[graph=term =path ~] ~]
==
:- %graph-update
:- %graph-update-0
=- ~& update=- -
.^(=update:graph-store %cx path)

View File

@ -5,6 +5,6 @@
|= $: [now=@da eny=@uvJ =beak]
[[=resource ~] ~]
==
:- %graph-update
:- %graph-update-0
^- update
[%0 now [%remove-graph resource]]

View File

@ -5,6 +5,6 @@
|= $: [now=@da eny=@uvJ =beak]
[[=resource indices=(set index) ~] ~]
==
:- %graph-update
:- %graph-update-0
^- update
[%0 now [%remove-nodes resource indices]]

View File

@ -6,6 +6,6 @@
|= $: [now=@da eny=@uvJ =beak]
[[[=resource =index] =signatures ~] ~]
==
:- %graph-update
:- %graph-update-0
^- update
[%0 now [%remove-signatures [resource index] signatures]]

View File

@ -5,6 +5,6 @@
|= $: [now=@da eny=@uvJ =beak]
[[=term =resource ~] ~]
==
:- %graph-update
:- %graph-update-0
^- update
[%0 now [%remove-tag term resource]]

View File

@ -5,6 +5,6 @@
|= $: [now=@da eny=@uvJ =beak]
[[=resource ~] ~]
==
:- %graph-update
:- %graph-update-0
^- update
[%0 now [%unarchive-graph resource]]

View File

@ -5,6 +5,6 @@
|= $: [now=@da eny=@uvJ =beak]
[[=ship =term ranks=(list rank:title) ~] ~]
==
:- %group-update
:- %group-update-0
^- action
[%change-policy [ship term] %open %allow-ranks (sy ranks)]

View File

@ -5,6 +5,6 @@
|= $: [now=@da eny=@uvJ =beak]
[[=ship =term ships=(list ship) ~] ~]
==
:- %group-update
:- %group-update-0
^- action
[%change-policy [ship term] %open %allow-ships (sy ships)]

View File

@ -5,6 +5,6 @@
|= $: [now=@da eny=@uvJ =beak]
[[=ship =term ranks=(list rank:title) ~] ~]
==
:- %group-update
:- %group-update-0
^- action
[%change-policy [ship term] %open %ban-ranks (sy ranks)]

View File

@ -5,6 +5,6 @@
|= $: [now=@da eny=@uvJ =beak]
[[=ship =term ships=(list ship) ~] ~]
==
:- %group-update
:- %group-update-0
^- action
[%change-policy [ship term] %open %ban-ships (sy ships)]

View File

@ -5,6 +5,6 @@
|= $: [now=@da eny=@uvJ =beak]
[[=term ~] ~]
==
:- %group-update
:- %group-action
^- action
[%add-group [p.beak term] *open:policy %.n]

View File

@ -0,0 +1,8 @@
/- *pull-hook
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[=ship =term ~] ~]
==
:- %pull-hook-action
^- action
[%add ship ship term]

View File

@ -0,0 +1,8 @@
/- *push-hook
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[=term ~] ~]
==
:- %push-hook-action
^- action
[%add p.beak term]

View File

@ -66,7 +66,7 @@
=/ real=(set resource:re)
=/ upd=update:ga
%+ scry update:ga
[%x %graph-store /keys/graph-update]
[%x %graph-store /keys/graph-update-0]
?> ?=(%keys -.q.upd)
resources.q.upd
:: count activity per channel

View File

@ -5,12 +5,10 @@
::
|_ =bowl:gall
++ scry
|* [desk=@tas =path]
?> ?=(^ path)
?> ?=(^ t.path)
|= [desk=@tas =path]
%+ weld
/(scot %p our.bowl)/[desk]/(scot %da now.bowl)
t.t.path
path
::
++ pass
|_ =wire
@ -105,6 +103,13 @@
^- card
[%give %fact ~ cage]
::
++ fact-init-kick
|= =cage
^- (list card)
:~ (fact cage ~)
(kick ~)
==
::
++ fact
|= [=cage paths=(list path)]
^- card

View File

@ -0,0 +1,52 @@
:: pull-hook-virt: virtualisation for pull-hook
/- *resource
|_ =bowl:gall
++ mule-scry
|= [ref=* raw=*]
=/ pax=(unit path)
((soft path) raw)
?~ pax ~
?. ?=([@ @ @ @ *] u.pax) ~
=/ ship
(slaw %p i.t.u.pax)
=/ ved
(slay i.t.t.t.u.pax)
=/ dat
?~ ved now.bowl
=/ cas=(unit case)
((soft case) p.u.ved)
?~ cas now.bowl
?: ?=(%da -.u.cas)
p.u.cas
now.bowl
:: catch bad gall scries early
?: ?& =((end 3 i.u.pax) %g)
?| !=(`our.bowl ship)
!=(dat now.bowl)
==
==
~
``.^(* u.pax)
::
++ kick-mule
|= [rid=resource trp=(trap *)]
^- (unit (unit path))
=/ res=toon
(mock [trp %9 2 %0 1] mule-scry)
=/ pax=(unit path)
!< (unit path)
:- -:!>(*(unit path))
?:(?=(%0 -.res) p.res ~)
?: !?=(%0 -.res)
=/ =tang
:+ leaf+"failed kick handler, please report"
leaf+"{<rid>} in {(trip dap.bowl)}"
?: ?=(%2 -.res)
p.res
?> ?=(%1 -.res)
=/ maybe-path=(unit path) ((soft path) p.res)
?~ maybe-path ~
[(smyt u.maybe-path) ~]
((slog tang) ~)
`pax
--

View File

@ -19,7 +19,7 @@
:: %pull-hook-action: Add/remove a resource from pulling.
::
/- *pull-hook
/+ default-agent, resource
/+ default-agent, resource, versioning, agentio, pull-hook-virt
|%
:: JSON conversions
++ dejs
@ -44,7 +44,8 @@
:: $config: configuration for the pull hook
::
:: .store-name: name of the store to send subscription updates to.
:: .update-mark: mark that updates will be tagged with
:: .update-mark: mark that updates will be tagged with, without
:: version number
:: .push-hook-name: name of the corresponding push-hook
:: .no-validate: If true, don't validate that resource/wire/src match
:: up
@ -54,6 +55,8 @@
update=mold
update-mark=term
push-hook-name=term
version=@ud
min-version=@ud
no-validate=_|
==
::
@ -73,16 +76,35 @@
failed-kicks=(map resource ship)
==
::
+$ track
[=ship =status]
::
+$ status
$% [%active ~]
[%failed-kick ~]
[%pub-ver ver=@ud]
[%sub-ver ver=@ud]
==
::
+$ base-state-2
$: tracking=(map resource track)
inner-state=vase
==
::
+$ state-0 [%0 base-state-0]
::
+$ state-1 [%1 base-state-0]
::
+$ state-2 [%2 base-state-1]
::
+$ state-3 [%3 base-state-2]
::
+$ versioned-state
$% state-0
state-1
state-2
state-3
==
::
++ default
@ -176,7 +198,7 @@
++ agent
|* =config
|= =(pull-hook config)
=| state-2
=| state-3
=* state -
^- agent:gall
=<
@ -185,6 +207,7 @@
og ~(. pull-hook bowl)
hc ~(. +> bowl)
def ~(. (default-agent this %|) bowl)
ver ~(. versioning [bowl [update-mark version min-version]:config])
::
++ on-init
^- [(list card:agent:gall) agent:gall]
@ -199,55 +222,48 @@
=| cards=(list card:agent:gall)
|^
?- -.old
%2
%3
=^ og-cards pull-hook
(on-load:og inner-state.old)
=. state old
=^ retry-cards state
retry-failed-kicks
=^ [restart-cards=(list card) hook=_pull-hook] state
restart-subs
=. pull-hook hook
:_ this
:(weld cards og-cards retry-cards)
::
:(weld cards og-cards restart-cards)
::
%2 $(old (state-to-3 old))
%1 $(old [%2 +.old ~])
::
%0
%_ $
-.old %1
::
cards
(weld cards (missing-subscriptions tracking.old))
==
%0 !! :: pre-breach
==
::
++ retry-failed-kicks
=| acc-cards=(list card)
=/ failures=(list [rid=resource =ship])
~(tap by failed-kicks)
=. tracking
(~(uni by tracking) failed-kicks)
=. failed-kicks ~
|- ^- (quip card _state)
?~ failures
[acc-cards state]
=, failures
=^ crds state
(handle-kick:hc i)
$(failures t, acc-cards (weld acc-cards crds))
++ state-to-3
|= old=state-2
%* . *state-3
tracking (tracking-to-3 tracking.old)
inner-state inner-state.old
==
::
++ missing-subscriptions
|= tracking=(map resource ship)
^- (list card:agent:gall)
%+ murn
~(tap by tracking)
|= [rid=resource =ship]
^- (unit card:agent:gall)
=/ =path
resource+(en-path:resource rid)
=/ =wire
(make-wire pull+path)
?: (~(has by wex.bowl) [wire ship push-hook-name.config])
~
`[%pass wire %agent [ship push-hook-name.config] %watch path]
++ tracking-to-3
|= trk=(map resource ship)
%- ~(gas by *(map resource track))
%+ turn ~(tap by trk)
|= [=resource =ship]
:- resource
[ship %active ~]
::
++ restart-subs
=| acc-cards=(list card)
=/ subs=(list resource)
~(tap in ~(key by tracking))
|- ^- [[(list card) _pull-hook] _state]
?~ subs
[[acc-cards pull-hook] state]
=* rid i.subs
=^ [crds=(list card) hook=_pull-hook] state
tr-abet:tr-on-load:(tr-abed:track-engine:hc rid)
=. pull-hook hook
$(subs t.subs, acc-cards (weld acc-cards crds))
--
::
++ on-save
@ -272,8 +288,9 @@
::
%pull-hook-action
?> (team:title [our src]:bowl)
=^ cards state
(poke-hook-action:hc !<(action vase))
=^ [cards=(list card) hook=_pull-hook] state
tr-abet:(tr-hook-act:track-engine:hc !<(action vase))
=. pull-hook hook
[cards this]
==
::
@ -295,72 +312,312 @@
=^ cards pull-hook
(on-agent:og wire sign)
[cards this]
?. ?=([%pull %resource *] t.t.wire)
?: ?=([%version ~] t.t.wire)
=^ [cards=(list card) hook=_pull-hook] state
(take-version:hc src.bowl sign)
=. pull-hook hook
[cards this]
?. ?=([%pull ?(%unver-resource %resource) *] t.t.wire)
(on-agent:def wire sign)
=/ rid=resource
(de-path:resource t.t.t.t.wire)
?+ -.sign (on-agent:def wire sign)
%kick
=^ cards state
(handle-kick:hc rid src.bowl)
[cards this]
::
%watch-ack
?~ p.sign
[~ this]
=. tracking
(~(del by tracking) rid)
=^ cards pull-hook
(on-pull-nack:og rid u.p.sign)
:_ this
[give-update cards]
::
%fact
?. =(update-mark.config p.cage.sign)
=^ cards pull-hook
(on-agent:og wire sign)
[cards this]
:_ this
~[(update-store:hc rid q.cage.sign)]
==
++ on-leave
|= =path
^- [(list card:agent:gall) agent:gall]
=^ cards pull-hook
(on-leave:og path)
[cards this]
::
++ on-arvo
|= [=wire =sign-arvo]
^- [(list card:agent:gall) agent:gall]
=^ cards pull-hook
(on-arvo:og wire sign-arvo)
[cards this]
++ on-fail
|= [=term =tang]
^- [(list card:agent:gall) agent:gall]
=^ cards pull-hook
(on-fail:og term tang)
[cards this]
++ on-peek
|= =path
^- (unit (unit cage))
?: =(/x/dbug/state path)
``noun+(slop !>(state(inner-state *vase)) on-save:og)
?. =(/x/tracking path)
(on-peek:og path)
``noun+!>(~(key by tracking))
=/ versioned=?
?=(%resource i.t.t.t.wire)
=^ [cards=(list card) hook=_pull-hook] state
tr-abet:(tr-sign:(tr-abed:track-engine:hc rid) sign versioned)
=. pull-hook hook
[cards this]
::
++ on-leave
|= =path
^- [(list card:agent:gall) agent:gall]
=^ cards pull-hook
(on-leave:og path)
[cards this]
::
++ on-arvo
|= [=wire =sign-arvo]
^- [(list card:agent:gall) agent:gall]
=^ cards pull-hook
(on-arvo:og wire sign-arvo)
[cards this]
::
++ on-fail
|= [=term =tang]
^- [(list card:agent:gall) agent:gall]
=^ cards pull-hook
(on-fail:og term tang)
[cards this]
::
++ on-peek
|= =path
^- (unit (unit cage))
?: =(/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)
io ~(. agentio bowl)
pass pass:io
virt ~(. pull-hook-virt bowl)
ver ~(. versioning [bowl [update-mark version min-version]:config])
::
++ track-engine
|_ [cards=(list card) rid=resource =ship =status gone=_|]
:: +| %init: state machine setup and manipulation
::
++ tr-core .
++ tr-abed
|= r=resource
=/ [s=^ship sta=^status]
(~(got by tracking) r)
tr-core(rid r, ship s, status sta)
::
++ tr-abet
^- [[(list card) _pull-hook] _state]
=. tracking
?: gone
(~(del by tracking) rid)
(~(put by tracking) rid [ship status])
[[(flop cards) pull-hook] state]
::
++ tr-emit
|= =card
tr-core(cards [card cards])
::
++ tr-emis
|= caz=(list card)
tr-core(cards (welp (flop cards) cards))
::
++ tr-ap-og
|= ap=_^?(|.(*(quip card _pull-hook)))
=^ caz pull-hook
(ap)
(tr-emis caz)
:: +| %sign: sign handling
::
::
++ tr-sign
|= [=sign:agent:gall versioned=?]
|^
?+ -.sign !!
%kick tr-kick
%watch-ack (tr-wack +.sign)
%fact (tr-fact +.sign)
==
::
++ tr-wack
|= tan=(unit tang)
?~ tan tr-core
?. versioned
(tr-ap-og:tr-cleanup |.((on-pull-nack:og rid u.tan)))
=/ pax
(kick-mule:virt rid |.((on-pull-kick:og rid)))
?~ pax tr-failed-kick
?~ u.pax tr-cleanup
(tr-watch-unver u.u.pax)
::
++ tr-fact
|= =cage
?: ?=(%version p.cage)
=/ req-ver=@ud
!<(@ud q.cage)
?: (lth req-ver min-version.config)
(tr-suspend-pub-ver min-version.config)
(tr-suspend-sub-ver req-ver)
?> (is-root:ver p.cage)
=/ fact-ver=@ud
(read-version:ver p.cage)
?. (gte fact-ver min-version.config)
(tr-suspend-pub-ver min-version.config)
=/ =vase
(convert-to:ver cage)
=/ =wire
(make-wire /store)
=+ resources=(~(gas in *(set resource)) (resource-for-update:og vase))
?> ?| no-validate.config
?& (check-src resources)
(~(has in resources) rid)
== ==
=/ =mark
(append-version:ver version.config)
(tr-emit (~(poke-our pass wire) store-name.config mark vase))
--
::
++ tr-kick
?. ?=(%active -.status) tr-core
=/ pax
(kick-mule:virt rid |.((on-pull-kick:og rid)))
?~ pax tr-failed-kick
?~ u.pax tr-cleanup
(tr-watch u.u.pax)
:: +| %lifecycle: lifecycle management for tracked resource
::
::
++ tr-add
|= [s=^ship r=resource]
=: ship s
rid r
status [%active ~]
==
(tr-watch /)
::
++ tr-remove
tr-leave:tr-cleanup
::
++ tr-hook-act
|= =action
^+ tr-core
?- -.action
%add (tr-add +.action)
%remove tr-remove:(tr-abed resource.action)
==
::
++ tr-cleanup
=. gone %.y
(tr-emit give-update)
::
++ tr-failed-kick
tr-core(status [%failed-kick ~])
::
++ tr-suspend-pub-ver
|= ver=@ud
=. status [%pub-ver ver]
tr-leave:tr-watch-ver
::
::
++ tr-suspend-sub-ver
|= ver=@ud
tr-core(status [%sub-ver ver])
::
++ tr-on-load
?+ -.status tr-core
%failed-kick tr-restart
%active tr-rewatch
::
%sub-ver
?. (supported:ver (append-version:ver ver.status))
tr-core
tr-restart
==
::
++ tr-restart
=. status [%active ~]
tr-kick
::
++ tr-rewatch
tr-kick:tr-leave
::
::
:: +| %subscription: subscription cards
::
::
++ tr-ver-wire
(make-wire /version)
::
++ tr-watch-ver
(tr-emit (watch-version ship))
::
++ tr-leave-ver
(tr-emit (~(leave pass tr-ver-wire) tr-sub-dock))
++ tr-sub-wire
(make-wire pull+resource+(en-path:resource rid))
++ tr-unver-sub-wire
(make-wire pull+unver-resource+(en-path:resource rid))
::
++ tr-sub-dock
^- dock
[ship push-hook-name.config]
::
++ tr-check-sub
?: (~(has by wex.bowl) [tr-sub-wire tr-sub-dock])
tr-core
tr-kick
::
++ tr-watch-unver
|= pax=path
=/ =path
:- %resource
(weld (en-path:resource rid) pax)
(tr-emit (~(watch pass tr-unver-sub-wire) tr-sub-dock path))
::
++ tr-watch
|= pax=path
^+ tr-core
=/ =path
:+ %resource %ver
%+ weld
(snoc (en-path:resource rid) (scot %ud version.config))
pax
(tr-emit (~(watch pass tr-sub-wire) tr-sub-dock path))
::
++ tr-leave
(tr-emit (~(leave pass tr-sub-wire) tr-sub-dock))
--
::
++ take-version
|= [who=ship =sign:agent:gall]
^- [[(list card) _pull-hook] _state]
?+ -.sign !!
%watch-ack
?~ p.sign [~^pull-hook state]
=/ =tank leaf+"subscribe failed from {<dap.bowl>} on wire {<wire>}"
%- (slog tank u.p.sign)
[~^pull-hook state]
::
%kick
:_ state
[(watch-version who)^~ pull-hook]
::
%fact
?. =(%version p.cage.sign)
[~^pull-hook state]
=+ !<(version=@ud q.cage.sign)
=/ tracks=(list [rid=resource =track])
~(tap by tracking)
=| cards=(list card)
=| leave=_&
|-
?~ tracks
=? cards leave
:_(cards (leave-version who))
[[cards pull-hook] state]
?. ?=(%pub-ver -.status.track.i.tracks)
$(tracks t.tracks)
?. =(who ship.track.i.tracks)
$(tracks t.tracks)
?. =(ver.status.track.i.tracks version)
=. leave %.n
$(tracks t.tracks)
=^ [caz=(list card) hook=_pull-hook] state
tr-abet:tr-restart:(tr-abed:track-engine rid.i.tracks)
=. pull-hook hook
$(tracks t.tracks, cards (weld cards caz))
==
::
++ version-wir
(make-wire /version)
::
++ watch-version
|= =ship
(~(watch pass version-wir) [ship push-hook-name.config] /version)
::
++ leave-version
|= =ship
(~(leave pass version-wir) [ship push-hook-name.config])
::
++ poke-sane
^- (quip card:agent:gall _state)
=/ cards
restart-subscriptions
:: TODO revive
~ :: restart-subscriptions
~? > ?=(^ cards)
"Fixed subscriptions in {<dap.bowl>}"
:_ state
restart-subscriptions
[cards state]
::
++ check-subscription
|= [rid=resource =ship]
@ -375,122 +632,6 @@
=(`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=*]
=/ pax=(unit path)
((soft path) raw)
?~ pax ~
?. ?=([@ @ @ @ *] u.pax) ~
=/ ship
(slaw %p i.t.u.pax)
=/ ved
(slay i.t.t.t.u.pax)
=/ dat
?~ ved now.bowl
=/ cas=(unit case)
((soft case) p.u.ved)
?~ cas now.bowl
?: ?=(%da -.u.cas)
p.u.cas
now.bowl
:: catch bad gall scries early
?: ?& =((end 3 i.u.pax) %g)
?| !=(`our.bowl ship)
!=(dat now.bowl)
==
==
~
``.^(* u.pax)
::
++ handle-kick
|= [rid=resource =ship]
^- (quip card _state)
=/ res=toon
(mock [|.((on-pull-kick:og rid)) %9 2 %0 1] mule-scry)
=/ pax=(unit path)
!< (unit path)
:- -:!>(*(unit path))
?:(?=(%0 -.res) p.res ~)
=? failed-kicks !?=(%0 -.res)
=/ =tang
:+ leaf+"failed kick handler, please report"
leaf+"{<rid>} in {(trip dap.bowl)}"
?: ?=(%2 -.res)
p.res
?> ?=(%1 -.res)
=/ maybe-path=(unit path) ((soft path) p.res)
?~ maybe-path ~
[(smyt u.maybe-path) ~]
%- (slog tang)
(~(put by failed-kicks) rid ship)
?^ pax
:_ state
(watch-resource rid u.pax)
=. tracking
(~(del by tracking) rid)
:_ state
~[give-update]
::
++ poke-hook-action
|= =action
^- [(list card:agent:gall) _state]
|^
?- -.action
%add (add +.action)
%remove (remove +.action)
==
++ add
|= [=ship =resource]
~| resource
?< |(=(our.bowl ship) =(our.bowl entity.resource))
?: (~(has by tracking) resource)
[~ state]
=. tracking
(~(put by tracking) resource ship)
:_ state
(watch-resource resource /)
::
++ remove
|= =resource
:- (leave-resource resource)
state(tracking (~(del by tracking) resource))
--
::
++ leave-resource
|= rid=resource
^- (list card)
=/ ship=(unit ship)
(~(get by tracking) rid)
?~ ship ~
=/ =wire
(make-wire pull+resource+(en-path:resource rid))
[%pass wire %agent [u.ship push-hook-name.config] %leave ~]~
::
++ watch-resource
|= [rid=resource pax=path]
^- (list card)
=/ ship=(unit ship)
(~(get by tracking) rid)
?~ ship ~
=/ =path
(welp resource+(en-path:resource rid) pax)
=/ =wire
(make-wire pull+resource+(en-path:resource rid))
[%pass wire %agent [u.ship push-hook-name.config] %watch path]~
::
++ make-wire
|= =wire
@ -509,20 +650,8 @@
%+ roll ~(tap in resources)
|= [rid=resource out=_|]
?: out %.y
?~ ship=(~(get by tracking) rid)
?~ status=(~(get by tracking) rid)
%.n
=(src.bowl u.ship)
::
++ update-store
|= [wire-rid=resource =vase]
^- card
=/ =wire
(make-wire /store)
=+ 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]
=(src.bowl ship.u.status)
--
--

View File

@ -25,7 +25,7 @@
:: foreign push-hook
::
/- *push-hook
/+ default-agent, resource, verb
/+ default-agent, resource, verb, versioning, agentio
|%
+$ card card:agent:gall
::
@ -43,6 +43,8 @@
update=mold
update-mark=term
pull-hook-name=term
version=@ud
min-version=@ud
==
::
:: $base-state-0: state for the push hook
@ -160,6 +162,9 @@
og ~(. push-hook bowl)
hc ~(. +> bowl)
def ~(. (default-agent this %|) bowl)
io ~(. agentio bowl)
pass pass:io
ver ~(. versioning [bowl [update-mark version min-version]:config])
::
++ on-init
=^ cards push-hook
@ -177,7 +182,14 @@
%1
=^ og-cards push-hook
(on-load:og inner-state.old)
[(weld cards og-cards) this(state old)]
=/ old-subs
find-old-subs
=/ version-cards
:- (fact:io version+!>(version.config) /version ~)
?~ old-subs ~
(kick:io old-subs)^~
[:(weld cards og-cards version-cards) this(state old)]
::
::
%0
%_ $
@ -192,6 +204,19 @@
==
==
::
++ find-old-subs
%~ tap in
%+ roll
~(val by sup.bowl)
|= [[=ship =path] out=(set path)]
?. ?=([%resource *] path) out
?. ?=([%resource %ver] path)
(~(put in out) path)
=/ path-ver=@ud
(ver-from-path:hc path)
?: (supported:ver (append-version:ver path-ver)) out
(~(put in out) path)
::
++ kicked-watches
^- (list path)
%~ tap in
@ -218,13 +243,9 @@
(poke-hook-action:hc !<(action vase))
[cards this]
::
?: =(mark update-mark.config)
?: (team:title [our src]:bowl)
:_ this
(forward-update:hc vase)
=^ cards state
(poke-update:hc vase)
[cards this]
?: (is-root:ver mark)
:_ this
(forward-update:hc mark vase)
::
=^ cards push-hook
(on-poke:og mark vase)
@ -233,17 +254,38 @@
++ on-watch
|= =path
^- (quip card:agent:gall agent:gall)
?: ?=([%version ~] path)
:_ this
(fact-init:io version+!>(min-version.config))^~
?. ?=([%resource *] path)
=^ cards push-hook
(on-watch:og path)
[cards this]
?> ?=([%ship @ @ *] t.path)
|^
?. ?=([%ver %ship @ @ @ *] t.path)
unversioned
=/ =resource
(de-path:resource t.path)
(de-path:resource t.t.path)
=/ =mark
(append-version:ver (slav %ud i.t.t.t.t.t.path))
?. (supported:ver mark)
:_ this
(fact-init-kick:io version+!>(min-version.config))
=/ =vase
(initial-watch:og t.t.t.t.path resource)
(convert-to:ver mark (initial-watch:og t.t.t.t.t.t.path resource))
:_ this
[%give %fact ~ update-mark.config vase]~
[%give %fact ~ mark vase]~
::
++ unversioned
?> ?=([%ship @ @ *] t.path)
=/ =resource
(de-path:resource t.path)
=/ =vase
%+ convert-to:ver update-mark.config
(initial-watch:og t.t.t.t.path resource)
:_ this
[%give %fact ~ update-mark.config vase]~
--
::
++ on-agent
|= [=wire =sign:agent:gall]
@ -258,7 +300,7 @@
%kick [~[watch-store:hc] this]
::
%fact
?. =(update-mark.config p.cage.sign)
?. (is-root:ver p.cage.sign)
=^ cards push-hook
(on-agent:og wire sign)
[cards this]
@ -266,7 +308,7 @@
(take-update:og q.cage.sign)
:_ this
%+ weld
(push-updates:hc q.cage.sign)
(push-updates:hc cage.sign)
cards
==
::
@ -299,15 +341,9 @@
--
|_ =bowl:gall
+* og ~(. push-hook bowl)
::
++ poke-update
|= vas=vase
^- (quip card:agent:gall _state)
=/ vax=(unit vase) (transform-proxy-update:og vas)
?> ?=(^ vax)
=/ wire (make-wire /store)
:_ state
[%pass wire %agent [our.bowl store-name.config] %poke update-mark.config u.vax]~
ver ~(. versioning [bowl [update-mark version min-version]:config])
io ~(. agentio bowl)
pass pass:io
::
++ poke-hook-action
|= =action
@ -378,26 +414,53 @@
[%pass wire %agent [our.bowl store-name.config] %watch store-path.config]
::
++ push-updates
|= =vase
|= =cage
^- (list card:agent:gall)
%+ murn (resource-for-update vase)
|= rid=resource
^- (unit card:agent:gall)
=/ prefix=path resource+(en-path:resource rid)
=/ paths=(list path)
%~ tap in
%- silt
%+ turn
(incoming-subscriptions prefix)
tail
?~ paths ~
`[%give %fact paths update-mark.config vase]
%+ roll (resource-for-update q.cage)
|= [rid=resource cards=(list card)]
|^
:(weld cards versioned unversioned)
::
++ versioned
^- (list card:agent:gall)
=/ prefix=path
resource+ver+(en-path:resource rid)
=/ paths=(jug @ud path)
%+ roll
(incoming-subscriptions prefix)
|= [[ship =path] out=(jug @ud path)]
=/ path-ver=@ud
(ver-from-path path)
(~(put ju out) path-ver path)
%+ turn ~(tap by paths)
|= [fact-ver=@ud paths=(set path)]
=/ =mark
(append-version:ver fact-ver)
=/ =^cage
:- mark
(convert-from:ver mark q.cage)
(fact:io cage ~(tap in paths))
:: TODO: deprecate
++ unversioned
=/ prefix=path
resource+(en-path:resource rid)
=/ unversioned=(set path)
%- ~(gas in *(set path))
(turn (incoming-subscriptions prefix) tail)
?: =(0 ~(wyt in unversioned)) ~
=/ =^cage
:- update-mark.config
(convert-from:ver update-mark.config q.cage)
(fact:io cage ~(tap in unversioned))^~
--
::
++ forward-update
|= vas=vase
|= =cage
^- (list card:agent:gall)
=- lis
%+ roll (resource-for-update vas)
=/ vas
(convert-to:ver cage)
%+ roll (resource-for-update q.cage)
|= [rid=resource [lis=(list card:agent:gall) tf-vas=(unit vase)]]
^- [(list card:agent:gall) (unit vase)]
=/ =path
@ -415,7 +478,7 @@
:: transform before poking store
::
(transform-proxy-update:og vas)
~| "forwarding failed during transform. mark: {<p.vas>} resource: {<rid>}"
~| "forwarding failed during transform. mark: {<p.cage>} resource: {<rid>}"
?> ?=(^ tf-vas)
=/ =dock
:- ship
@ -426,8 +489,18 @@
:: poke our store
::
store-name.config
=/ cag=^cage
:- current-version:ver
u.tf-vas
:_ tf-vas
[[%pass wire %agent dock %poke update-mark.config u.tf-vas] lis]
[[%pass wire %agent dock %poke cag] lis]
::
++ ver-from-path
|= =path
=/ extra=^path
(slag 5 path)
?> ?=(^ extra)
(slav %ud i.extra)
::
++ resource-for-update
|= =vase

View File

@ -0,0 +1,53 @@
/+ agentio
|_ [=bowl:gall root=mark version=@ud min=@ud]
+* io ~(. agentio bowl)
++ is-root
|= =mark
?~ (rush mark mark-parser)
%.n
%.y
::
++ mark-parser
;~(pfix (jest root) ;~(pose ;~(pfix hep dum:ag) (easy `@ud`0)))
::
++ read-version
|= =mark
(rash mark mark-parser)
::
++ append-version
|= ver=@ud
:((cury cat 3) root '-' (scot %ud ver))
::
++ current-version
^- mark
(append-version version)
::
++ supported
|= =mark
=/ ver
(read-version mark)
&((gte ver min) (lte ver version))
::
++ convert-to
|= =cage
^- vase
?: =(p.cage current-version)
q.cage
((tube-to p.cage) q.cage)
::
++ tube-to
|= =mark
.^(tube:clay %cc (scry:io %home /[mark]/[current-version]))
::
++ tube-from
|= =mark
.^(tube:clay %cc (scry:io %home /[current-version]/[mark]))
::
++ convert-from
|= =cage
^- vase
?: =(p.cage current-version)
q.cage
((tube-from p.cage) q.cage)
--

View File

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

View File

@ -5,6 +5,7 @@
++ grow
|%
++ noun upd
++ contact-update-0 upd
++ json (update:enjs upd)
--
::

View File

@ -0,0 +1,16 @@
/- *demo
::
|_ upd=update
++ grad %noun
++ grow
|%
++ noun upd
++ demo-update-1 upd
++ demo-update upd
--
::
++ grab
|%
++ noun update
--
--

View File

@ -0,0 +1,15 @@
/- *demo
::
|_ upd=update
++ grad %noun
++ grow
|%
++ noun upd
++ demo-update-0 upd
--
::
++ grab
|%
++ noun update
--
--

View File

@ -0,0 +1,16 @@
/- *demo
::
|_ upd=update
++ grad %noun
++ grow
|%
++ noun upd
++ demo-update-1 upd
++ demo-update-0 upd
--
::
++ grab
|%
++ noun update
--
--

View File

@ -0,0 +1,20 @@
/+ *graph-store
=* as-octs as-octs:mimes:html
::
|_ upd=update
++ grad %noun
++ grow
|%
++ noun upd
++ json (update:enjs upd)
++ graph-update upd
++ mime [/application/x-urb-graph-update (as-octs (jam upd))]
--
::
++ grab
|%
++ noun update
++ json update:dejs
++ mime |=([* =octs] ;;(update (cue q.octs)))
--
--

View File

@ -7,6 +7,7 @@
|%
++ noun upd
++ json (update:enjs upd)
++ graph-update-0 upd
++ mime [/application/x-urb-graph-update (as-octs (jam upd))]
--
::

View File

@ -0,0 +1,17 @@
/+ *group-store
|_ upd=update
++ grad %noun
++ grow
|%
++ noun upd
++ group-update upd
++ json
%+ frond:enjs:format 'groupUpdate'
(update:enjs upd)
--
++ grab
|%
++ noun update
++ json update:dejs
--
--

View File

@ -4,6 +4,7 @@
++ grow
|%
++ noun upd
++ group-update-0 upd
++ json
%+ frond:enjs:format 'groupUpdate'
(update:enjs upd)

View File

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

View File

@ -4,6 +4,7 @@
++ grow
|%
++ noun update
++ metadata-update-0 update
++ json (update:enjs:store update)
--
::

11
pkg/arvo/mar/version.hoon Normal file
View File

@ -0,0 +1,11 @@
|_ ver=@ud
++ grad %noun
++ grow
|%
++ noun ver
--
++ grab
|%
++ noun @ud
--
--

10
pkg/arvo/sur/demo.hoon Normal file
View File

@ -0,0 +1,10 @@
/+ resource
|%
+$ update
$~ [%add *resource 0]
$% [%add p=resource q=@ud]
[%sub p=resource q=@ud]
[%ini p=resource ~]
[%run p=resource q=(list update)]
==
--

View File

@ -1006,7 +1006,7 @@
|= suffix=@tas
^- (list path)
=/ parser
(most hep (cook crip ;~(plug low (star ;~(pose low nud)))))
(most hep (cook crip ;~(plug ;~(pose low nud) (star ;~(pose low nud)))))
=/ torn=(list @tas) (fall (rush suffix parser) ~[suffix])
%- flop
|- ^- (list (list @tas))

View File

@ -33,7 +33,7 @@
=/ hashes (nodes-to-pending-indices nodes.q.update)
;< ~ bind:m
%^ poke-our %graph-push-hook
%graph-update
%graph-update-0
!>(update)
(pure:m !>(`action:graph-view`[%pending-indices hashes]))
::

View File

@ -25,12 +25,12 @@
(poke-our %metadata-push-hook push-hook-act)
;< ~ bind:m
%+ poke-our %group-store
:- %group-update
:- %group-update-0
!> ^- 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 ~)]))
(poke-our %group-store group-update-0+!>([%add-members rid (sy our.bowl ~)]))
;< ~ bind:m
(poke-our %group-push-hook push-hook-act)
(pure:m rid)
@ -54,7 +54,7 @@
=/ =update:graph
[%0 now.bowl %add-graph rid.action *graph:graph mark.action overwrite]
;< ~ bind:m
(poke-our %graph-store graph-update+!>(update))
(poke-our %graph-store graph-update-0+!>(update))
;< ~ bind:m
(poke-our %graph-push-hook %push-hook-action !>([%add rid.action]))
::
@ -78,7 +78,7 @@
=/ met-action=action:met
[%add group graph+rid.action metadatum]
;< ~ bind:m
(poke-our %metadata-push-hook metadata-update+!>(met-action))
(poke-our %metadata-push-hook metadata-update-0+!>(met-action))
::
:: Send invites
::

View File

@ -36,12 +36,12 @@
^- form:m
;< =bowl:spider bind:m get-bowl:strandio
;< ~ bind:m
(poke-our %graph-store %graph-update !>([%0 now.bowl %remove-graph rid]))
(poke-our %graph-store %graph-update-0 !>([%0 now.bowl %remove-graph rid]))
;< ~ bind:m
(poke-our %graph-push-hook %push-hook-action !>([%remove rid]))
;< ~ bind:m
%+ poke-our %metadata-push-hook
:- %metadata-update
:- %metadata-update-0
!> ^- action:metadata
[%remove group-rid [%graph rid]]
(pure:m ~)
@ -63,7 +63,7 @@
(pure:m ~)
;< ~ bind:m
%+ poke [entity.grp-rid %group-push-hook]
:- %group-update
:- %group-update-0
!> ^- update:group-store
[%remove-tag grp-rid tag.i.tags tagged.i.tags]
loop(tags t.tags)

View File

@ -69,5 +69,5 @@
!> ^- action:met
[%remove rid.action [%graph rid.action]]
;< ~ bind:m
(poke-our %group-store %group-update !>([%remove-group rid.action ~]))
(poke-our %group-store %group-update-0 !>([%remove-group rid.action ~]))
(pure:m !>(~))

View File

@ -39,7 +39,7 @@
;< ~ bind:m
(poke-our %graph-pull-hook %pull-hook-action !>([%remove rid]))
;< ~ bind:m
(poke-our %graph-store %graph-update !>([%0 now [%remove-graph rid]]))
(poke-our %graph-store %graph-update-0 !>([%0 now [%remove-graph rid]]))
(pure:m ~)
--
::

View File

@ -17,7 +17,7 @@
;< =bowl:spider bind:m get-bowl:strandio
:: unarchive graph and share it
;< ~ bind:m
(poke-our %graph-store %graph-update !>([%0 now.bowl %unarchive-graph rid]))
(poke-our %graph-store %graph-update-0 !>([%0 now.bowl %unarchive-graph rid]))
;< ~ bind:m
(poke-our %graph-push-hook %push-hook-action !>([%add rid]))
::

View File

@ -24,7 +24,7 @@
!> ^- action:push-hook
[%remove resource.action]
;< ~ bind:m (cleanup-md:view rid)
;< ~ bind:m (poke-our %group-store %group-update !>([%remove-group rid ~]))
;< ~ bind:m (poke-our %group-store %group-update-0 !>([%remove-group rid ~]))
;< ~ bind:m (poke-our %metadata-push-hook push-hook-act)
;< ~ bind:m (poke-our %contact-push-hook push-hook-act)
;< ~ bind:m (poke-our %group-push-hook push-hook-act)

View File

@ -36,7 +36,7 @@
^- form:m
=/ =action:store
[%change-policy rid %invite %add-invites ships]
;< ~ bind:m (poke-our %group-push-hook %group-update !>(action))
;< ~ bind:m (poke-our %group-push-hook %group-update-0 !>(action))
(pure:m ~)
--
^- thread:spider

View File

@ -25,6 +25,6 @@
;< ~ bind:m (poke-our %contact-pull-hook pull-hook-act)
;< ~ bind:m (poke-our %metadata-pull-hook pull-hook-act)
;< ~ bind:m (poke-our %group-pull-hook pull-hook-act)
;< ~ bind:m (poke-our %group-store %group-update !>([%remove-group rid ~]))
;< ~ bind:m (poke-our %group-store %group-update-0 !>([%remove-group rid ~]))
;< ~ bind:m (cleanup-md:view rid)
(pure:m !>(~))

View File

@ -19,7 +19,7 @@
;< ~ bind:m
%+ raw-poke
[entity.resource.update %group-push-hook]
:- %group-update
:- %group-update-0
!> ^- update:grp
[%remove-members resource.update (silt [our.bowl ~])]
:: stop serving or syncing group updates
@ -70,7 +70,7 @@
;< ~ bind:m
%+ raw-poke
[our.bowl %graph-store]
:- %graph-update
:- %graph-update-0
!> ^- update:gra
[%0 now.bowl [%archive-graph app-resource]]
;< ~ bind:m

View File

@ -14,7 +14,7 @@
=/ =post:post [our index wen [%text body]~ ~ ~]
=/ =node:graph-store [post %empty ~]
=/ act=update:graph-store [%0 wen %add-nodes rid (my [index node] ~)]
(poke-app our %graph-push-hook %graph-update act)
(poke-app our %graph-push-hook %graph-update-0 act)
--
::
^- thread:spider

View File

@ -14,7 +14,7 @@
=/ =post:post [our index wen [%text body]~ ~ ~]
=/ =node:graph-store [post %empty ~]
=/ act=update:graph-store [%0 wen %add-nodes rid (my [index node] ~)]
(poke-app our %graph-push-hook %graph-update act)
(poke-app our %graph-push-hook %graph-update-0 act)
--
::
^- thread:spider

View File

@ -0,0 +1,43 @@
/+ pull-hook-virt, *test, resource
|%
++ bowl *bowl:gall
::
++ virt ~(. pull-hook-virt bowl)
::
++ test-mule-scry-bad-time
%+ expect-eq !>(~)
!> %+ mule-scry:virt **
/gx/(scot %p ~zod)/graph-store/(scot %da ~2010.1.1)/keys/noun
::
++ test-mule-scry-bad-ship
%+ expect-eq !>(~)
!> %+ mule-scry:virt **
/gx/(scot %p ~bus)/graph-store/(scot %da *time)/keys/noun
::
++ test-kick-mule
=/ rid=resource
[~zod %test]
=/ pax=path
/gx/(scot %p ~zod)/graph-store/(scot %da *time)/keys/noun
=/ test-trp=(trap *)
|.
:- ~
.^(path pax)
=/ harness-trp=(trap *)
|.((kick-mule:virt rid test-trp))
%+ expect-eq !>(``/foo)
!>
=/ res=toon
%+ mock [harness-trp %9 2 %0 1]
|= [ref=* raw=*]
=/ pox=(unit path)
((soft path) raw)
?~ pox ~
?: =(u.pox pax)
``/foo
``.^(* u.pox)
?> ?=(%0 -.res)
;;((unit (unit path)) p.res)
::
--

View File

@ -0,0 +1,49 @@
/+ versioning, *test
|%
++ ver ~(. versioning [*bowl:gall %update 2 1])
++ test-is-root
;: weld
%+ expect-eq !> %.y
!> (is-root:ver %update-0)
::
%+ expect-eq !> %.y
!> (is-root:ver %update)
::
%+ expect-eq !> %.n
!> (is-root:ver %not-update-0)
==
::
++ test-read-version
;: weld
%+ expect-eq !> 0
!> (read-version:ver %update-0)
::
%+ expect-eq !> 0
!> (read-version:ver %update)
::
%+ expect-eq !> 1
!> (read-version:ver %update-1)
==
::
++ test-append-version
;: weld
%+ expect-eq !> %update-0
!> (append-version:ver 0)
::
%+ expect-eq !> %update-1
!> (append-version:ver 1)
==
::
++ test-current-version
%+ expect-eq !> %update-2
!> current-version:ver
::
++ test-supported
;: weld
(expect !>((supported:ver %update-2)))
(expect !>((supported:ver %update-1)))
(expect !>(!(supported:ver %update-0)))
==
--

View File

@ -84,7 +84,7 @@ export default class ContactsApi extends BaseApi<StoreState> {
}
private storeAction(action: any): Promise<any> {
return this.action('contact-store', 'contact-update', action);
return this.action('contact-store', 'contact-update-0', action);
}
private viewAction(threadName: string, action: any) {
@ -92,6 +92,6 @@ export default class ContactsApi extends BaseApi<StoreState> {
}
private hookAction(ship: Patp, action: any): Promise<any> {
return this.action('contact-push-hook', 'contact-update', action);
return this.action('contact-push-hook', 'contact-update-0', action);
}
}

View File

@ -83,7 +83,7 @@ export default class GraphApi extends BaseApi<StoreState> {
joiningGraphs = new Set<string>();
private storeAction(action: any): Promise<any> {
return this.action('graph-store', 'graph-update', action);
return this.action('graph-store', 'graph-update-0', action);
}
private viewAction(threadName: string, action: any) {
@ -91,7 +91,7 @@ export default class GraphApi extends BaseApi<StoreState> {
}
private hookAction(ship: Patp, action: any): Promise<any> {
return this.action('graph-push-hook', 'graph-update', action);
return this.action('graph-push-hook', 'graph-update-0', action);
}
createManagedGraph(
@ -227,7 +227,7 @@ export default class GraphApi extends BaseApi<StoreState> {
};
const pendingPromise = this.spider(
'graph-update',
'graph-update-0',
'graph-view-action',
'graph-add-nodes',
action

View File

@ -83,11 +83,11 @@ export default class GroupsApi extends BaseApi<StoreState> {
}
private proxyAction(action: GroupAction) {
return this.action('group-push-hook', 'group-update', action);
return this.action('group-push-hook', 'group-update-0', action);
}
private storeAction(action: GroupAction) {
return this.action('group-store', 'group-update', action);
return this.action('group-store', 'group-update-0', action);
}
private viewThread(thread: string, action: any) {

View File

@ -103,6 +103,6 @@ export default class MetadataApi extends BaseApi<StoreState> {
}
private metadataAction(data) {
return this.action('metadata-push-hook', 'metadata-update', data);
return this.action('metadata-push-hook', 'metadata-update-0', data);
}
}

172
sh/test-hook Executable file
View File

@ -0,0 +1,172 @@
#!/usr/bin/env bash
reset_ship() {
ship=$1
pier=../../$ship
downgrade $ship
herb ./$pier -p hood -d "+hood/fade %demo-store"
herb ./$pier -p hood -d "+hood/fade %demo-pull-hook"
herb ./$pier -p hood -d "+hood/fade %demo-push-hook"
herb ./$pier -p hood -d "+hood/start %demo-store"
herb ./$pier -p hood -d "+hood/start %demo-pull-hook"
herb ./$pier -p hood -d "+hood/start %demo-push-hook"
#herb ./$pier -p demo-store -d "+verb"
#herb ./$pier -p demo-push-hook -d "+verb"
#herb ./$pier -p demo-pull-hook -d "+verb"
}
start() {
ship=$1
pier=../../$ship
herb ./$pier -p demo-store -d "+demo/ini %foo"
herb ./$pier -p demo-push-hook -d "+push/add %foo"
herb ./$pier -p demo-store -d "+demo/add 0 %foo 3"
}
poke_store() {
ship=$1
num=$2
ver=$3
pier=../../$ship
herb ./$pier -p demo-store -d "+demo/add $ver %foo $num"
}
sub() {
us=$1
them=$2
pier=../../$us
herb ./$pier -p demo-pull-hook -d "+pull/add ~$them %foo"
}
print() {
ship=$1
pier=../../$ship
herb ./$pier -p demo-store -d "+dbug"
herb ./$pier -p demo-push-hook -d "+dbug"
herb ./$pier -p demo-pull-hook -d "+dbug"
}
upgrade() {
ship=$1
pier=../../$ship
desk=$pier/home
gsed --in-place "s/demo-update-0/demo-update-1/g" $desk/app/demo-store.hoon
gsed --in-place "14s/.*/1/" $desk/app/demo-pull-hook.hoon
gsed --in-place "14s/.*/1/" $desk/app/demo-push-hook.hoon
herb ./$pier -p hood -d "+hood/commit %home"
}
upgrade_incompat() {
ship=$1
pier=../../$ship
desk=$pier/home
gsed --in-place "s/demo-update-0/demo-update-1/g" $desk/app/demo-store.hoon
gsed --in-place "14s/.*/1/" $desk/app/demo-pull-hook.hoon
gsed --in-place "15s/.*/1/" $desk/app/demo-pull-hook.hoon
gsed --in-place "14s/.*/1/" $desk/app/demo-push-hook.hoon
gsed --in-place "15s/.*/1/" $desk/app/demo-push-hook.hoon
herb ./$pier -p hood -d "+hood/commit %home"
}
downgrade() {
ship=$1
pier=../../$ship
desk=$pier/home
gsed --in-place "s/demo-update-1/demo-update-0/g" $desk/app/demo-store.hoon
gsed --in-place "14s/.*/0/" $desk/app/demo-pull-hook.hoon
gsed --in-place "15s/.*/0/" $desk/app/demo-pull-hook.hoon
gsed --in-place "14s/.*/0/" $desk/app/demo-push-hook.hoon
gsed --in-place "15s/.*/0/" $desk/app/demo-push-hook.hoon
herb ./$pier -p hood -d "+hood/commit %home"
}
sub_ahead() {
echo "subscriber ahead"
reset_ship "zod"
reset_ship "bus"
start "zod"
sub "bus" "zod"
sleep 2
print "zod"
print "bus"
sleep 2
upgrade "zod"
sleep 1
poke_store "zod" 5 1
sleep 2
print "zod"
print "bus"
}
sub_ahead_incompat() {
echo "subscriber ahead, incompatible"
reset_ship "zod"
reset_ship "bus"
start "zod"
sub "bus" "zod"
sleep 2
print "zod"
print "bus"
sleep 2
upgrade_incompat "bus"
sleep 1
print "bus"
poke_store "zod" 5 0
sleep 2
upgrade_incompat "zod"
sleep 3
print "zod"
print "bus"
}
pub_ahead() {
echo "publisher ahead"
reset_ship "zod"
reset_ship "bus"
start "zod"
sub "bus" "zod"
sleep 2
print "zod"
print "bus"
sleep 2
upgrade "zod"
sleep 1
poke_store "zod" 5 1
sleep 2
print "zod"
print "bus"
}
pub_ahead_incompat() {
echo "publisher ahead, incompatible"
reset_ship "zod"
reset_ship "bus"
start "zod"
sub "bus" "zod"
sleep 2
print "zod"
print "bus"
sleep 2
upgrade_incompat "zod"
sleep 1
poke_store "zod" 5 1
sleep 2
upgrade_incompat "bus"
sleep 3
print "zod"
print "bus"
}
pub_ahead_incompat