Merge branch 'master' into m/next-gen-term

Notably includes some changes to webterm's app.tsx that are required to
keep it functioning correctly. As of yet unclear why exactly this is
necessary, presumably hook shenanigans triggered by recent-ish changes.
This commit is contained in:
fang 2021-05-14 00:38:00 +02:00
commit 719ff8b442
No known key found for this signature in database
GPG Key ID: EB035760C1BBA972
510 changed files with 27083 additions and 23942 deletions

View File

@ -32,7 +32,29 @@
name: build
on: [push, pull_request]
on:
push:
paths:
- 'pkg/arvo/**'
- 'pkg/docker-image/**'
- 'pkg/ent/**'
- 'pkg/ge-additions/**'
- 'pkg/hs/**'
- 'pkg/libaes_siv/**'
- 'pkg/urbit/**'
- 'bin/**'
- 'nix/**'
pull_request:
paths:
- 'pkg/arvo/**'
- 'pkg/docker-image/**'
- 'pkg/ent/**'
- 'pkg/ge-additions/**'
- 'pkg/hs/**'
- 'pkg/libaes_siv/**'
- 'pkg/urbit/**'
- 'bin/**'
- 'nix/**'
jobs:
urbit:

View File

@ -2,7 +2,7 @@ name: glob
on:
push:
branches:
- 'release/next-js'
- 'release/next-userspace'
jobs:
glob:
runs-on: ubuntu-latest

View File

@ -6,13 +6,13 @@ on:
jobs:
merge-to-next-js:
runs-on: ubuntu-latest
name: "Merge master to release/next-js"
name: "Merge master to release/next-userspace"
steps:
- uses: actions/checkout@v2
- uses: devmasx/merge-branch@v1.3.1
with:
type: now
target_branch: release/next-js
target_branch: release/next-userspace
github_token: ${{ secrets.JANEWAY_BOT_TOKEN }}
merge-to-group-timer:

View File

@ -3,6 +3,8 @@ on:
push:
branches:
- 'master'
paths:
- 'pkg/npm/**'
jobs:
publish-api:
runs-on: ubuntu-latest

View File

@ -309,9 +309,9 @@ the new binary, and restarting the pier with it.
#### Continuous deployment
A subset of release branches are deployed continuously to the network. Thus far
this only includes `release/next-js`, which deploys livenet-compatible
JavaScript changes to select QA ships. Any push to master will automatically
merge master into `release/next-js` to keep the streams at parity.
this only includes `release/next-userspace`, which deploys livenet-compatible
changes to select QA ships. Any push to master will automatically
merge master into `release/next-userspace` to keep the streams at parity.
### Announce the update

View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1
oid sha256:0d5d569d5bb9abc36b515f9c0690974706ba615c624ff76fd299712695506863
size 9346854
oid sha256:d7b7cf24e56ab078cf1dcb82e4e7744f188c5221c08772d6cfb15f59ce81aaa5
size 11198219

View File

@ -25,4 +25,11 @@ in {
ldapSupport = false;
brotliSupport = false;
};
lmdb = prev.lmdb.overrideAttrs (attrs: {
patches =
optionalList attrs.patches ++ prev.lib.optional prev.stdenv.isDarwin [
../pkgs/lmdb/darwin-fsync.patch
];
});
}

View File

@ -1,10 +1,24 @@
{ urbit, libcap, coreutils, bashInteractive, dockerTools, writeScriptBin, amesPort ? 34343 }:
{ urbit, curl, libcap, coreutils, bashInteractive, dockerTools, writeScriptBin, amesPort ? 34343 }:
let
startUrbit = writeScriptBin "start-urbit" ''
#!${bashInteractive}/bin/bash
set -eu
# set defaults
amesPort=${toString amesPort}
# check args
for i in "$@"
do
case $i in
-p=*|--port=*)
amesPort="''${i#*=}"
shift
;;
esac
done
# If the container is not started with the `-i` flag
# then STDIN will be closed and we need to start
# Urbit/vere with the `-t` flag.
@ -23,7 +37,7 @@ let
mv $keyname /tmp
# Boot urbit with the key, exit when done booting
urbit $ttyflag -w $(basename $keyname .key) -k /tmp/$keyname -c $(basename $keyname .key) -p ${toString amesPort} -x
urbit $ttyflag -w $(basename $keyname .key) -k /tmp/$keyname -c $(basename $keyname .key) -p $amesPort -x
# Remove the keyfile for security
rm /tmp/$keyname
@ -34,7 +48,7 @@ let
cometname=''${comets[0]}
rm *.comet
urbit $ttyflag -c $(basename $cometname .comet) -p ${toString amesPort} -x
urbit $ttyflag -c $(basename $cometname .comet) -p $amesPort -x
fi
# Find the first directory and start urbit with the ship therein
@ -42,14 +56,44 @@ let
dirs=( $dirnames )
dirname=''${dirnames[0]}
urbit $ttyflag -p ${toString amesPort} $dirname
exec urbit $ttyflag -p $amesPort $dirname
'';
getUrbitCode = writeScriptBin "get-urbit-code" ''
#!${bashInteractive}/bin/bash
raw=$(curl -s -X POST -H "Content-Type: application/json" \
-d '{ "source": { "dojo": "+code" }, "sink": { "stdout": null } }' \
http://127.0.0.1:12321)
# trim \n" from the end
trim="''${raw%\\n\"}"
# trim " from the start
code="''${trim#\"}"
echo "$code"
'';
resetUrbitCode = writeScriptBin "reset-urbit-code" ''
#!${bashInteractive}/bin/bash
curl=$(curl -s -X POST -H "Content-Type: application/json" \
-d '{ "source": { "dojo": "+hood/code %reset" }, "sink": { "app": "hood" } }' \
http://127.0.0.1:12321)
if [[ $? -eq 0 ]]
then
echo "OK"
else
echo "Curl error: $?"
fi
'';
in dockerTools.buildImage {
name = "urbit";
tag = "v${urbit.version}";
contents = [ bashInteractive urbit startUrbit coreutils ];
contents = [ bashInteractive urbit curl startUrbit getUrbitCode resetUrbitCode coreutils ];
runAsRoot = ''
#!${bashInteractive}
mkdir -p /urbit

View File

@ -1,4 +1,4 @@
{ lib, stdenv, darwin, haskell-nix, gmp, zlib, libffi, brass
{ lib, stdenv, darwin, haskell-nix, lmdb, gmp, zlib, libffi, brass
, enableStatic ? stdenv.hostPlatform.isStatic }:
haskell-nix.stackProject {
@ -65,6 +65,7 @@ haskell-nix.stackProject {
enableShared = !enableStatic;
configureFlags = lib.optionals enableStatic [
"--ghc-option=-optl=-L${lmdb}/lib"
"--ghc-option=-optl=-L${gmp}/lib"
"--ghc-option=-optl=-L${libffi}/lib"
"--ghc-option=-optl=-L${zlib}/lib"
@ -81,6 +82,8 @@ haskell-nix.stackProject {
urbit-king.components.tests.urbit-king-tests.testFlags =
[ "--brass-pill=${brass.lfs}" ];
lmdb.components.library.libs = lib.mkForce [ lmdb ];
};
}];
}

View File

@ -0,0 +1,13 @@
diff --git a/libraries/liblmdb/mdb.c b/libraries/liblmdb/mdb.c
index fe65e30..0070215 100644
--- a/libraries/liblmdb/mdb.c
+++ b/libraries/liblmdb/mdb.c
@@ -2526,7 +2526,7 @@ mdb_env_sync(MDB_env *env, int force)
rc = ErrCode();
} else
#endif
- if (MDB_FDATASYNC(env->me_fd))
+ if (fcntl(env->me_fd, F_FULLFSYNC, 0))
rc = ErrCode();
}
}

View File

@ -45,17 +45,16 @@ Most parts of Arvo have dedicated maintainers.
* `/sys/vane/ames`: @belisarius222 (~rovnys-ricfer) & @philipcmonk (~wicdev-wisryt)
* `/sys/vane/behn`: @belisarius222 (~rovnys-ricfer)
* `/sys/vane/clay`: @philipcmonk (~wicdev-wisryt) & @belisarius222 (~rovnys-ricfer)
* `/sys/vane/dill`: @joemfb (~master-morzod)
* `/sys/vane/eyre`: @eglaysher (~littel-ponnys)
* `/sys/vane/dill`: @fang- (~palfun-foslup)
* `/sys/vane/eyre`: @fang- (~palfun-foslup)
* `/sys/vane/gall`: @philipcmonk (~wicdev-wisryt)
* `/sys/vane/jael`: @fang- (~palfun-foslup) & @philipcmonk (~wicdev-wisryt)
* `/app/acme`: @joemfb (~master-morzod)
* `/app/dns`: @joemfb (~master-morzod)
* `/app/aqua`: @philipcmonk (~wicdev-wisryt)
* `/app/hood`: @belisarius222 (~rovnys-ricfer)
* `/lib/hood/drum`: @philipcmonk (~wicdev-wisryt)
* `/lib/hood/drum`: @fang- (~palfun-foslup)
* `/lib/hood/kiln`: @philipcmonk (~wicdev-wisryt)
* `/lib/test`: @eglaysher (~littel-ponnys)
## Contributing

View File

@ -1394,8 +1394,6 @@
^+ this
?: =(~ dom)
~|(%acme-empty-certificate-order !!)
?: ?=(?(%earl %pawn) (clan:title our.bow))
this
=. ..emit (queue-next-order 1 | dom)
=. ..emit cancel-current-order
:: notify %dill

View File

@ -169,7 +169,7 @@
::
%fact
?+ p.cage.sign ~|([dap.bowl %bad-sub-mark wire p.cage.sign] !!)
%graph-update
%graph-update-2
%- on-graph-update:tc
!<(update:graph q.cage.sign)
==
@ -401,12 +401,16 @@
:: +read-post: add envelope to state and show it to user
::
++ read-post
|= [=target =index:post =post:post]
|= [=target =index:post =maybe-post:graph]
^- (quip card _session)
:- (show-post:sh-out target post)
%_ session
history [[target index] history.session]
count +(count.session)
?- -.maybe-post
%| [~ session]
%&
:- (show-post:sh-out target p.maybe-post)
%_ session
history [[target index] history.session]
count +(count.session)
==
==
::
++ notice-remove
@ -734,7 +738,8 @@
::
?. (is-chat-graph target)
[[(note:sh-out "no such chat")]~ put-ses]
=. viewing (~(put in viewing) target)
=. audience target
=. viewing (~(put in viewing) target)
=^ cards state
?: (~(has by bound) target)
[~ state]
@ -758,15 +763,15 @@
::TODO move creation into lib?
%^ act %out-message
%graph-push-hook
:- %graph-update
:- %graph-update-2
!> ^- update:graph
:+ %0 now.bowl
:- now.bowl
:+ %add-nodes audience
%- ~(put by *(map index:post node:graph))
:- ~[now.bowl]
:_ *internal-graph:graph
^- post:post
[our-self ~[now.bowl] now.bowl [msg]~ ~ ~]
^- maybe-post:graph
[%& `post:post`[our-self ~[now.bowl] now.bowl [msg]~ ~ ~]]
:: +eval: run hoon, send code and result as message
::
:: this double-virtualizes and clams to disable .^ for security reasons
@ -890,10 +895,12 @@
=/ =uid:post (snag index history)
=/ =node:graph (got-node:libgraph uid)
=. audience resource.uid
?: ?=(%| -.post.node)
[~ state]
:_ put-ses
^- (list card)
:~ (print:sh-out ['?' ' ' number])
(effect:sh-out ~(render-activate mr resource.uid post.node))
(effect:sh-out ~(render-activate mr resource.uid p.post.node))
prompt:sh-out
==
--
@ -1185,7 +1192,15 @@
?- -.content
%text txt+(trip text.content)
%url url+url.content
%reference txt+"[reference to msg in {~(phat tr resource.uid.content)}]"
::
%reference
?- -.reference.content
%graph
txt+"[reference to msg in {~(phat tr resource.uid.reference.content)}]"
::
%group
txt+"[reference to msg in {~(phat tr group.reference.content)}]"
==
::
%mention
?. =(ship.content our-self) txt+(scow %p ship.content)

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-2 !>(update))
::
++ nobody
^- @p
@ -190,7 +190,7 @@
cards
:_ cards
%- poke-graph-store
:+ %0 now.bol
:- now.bol
archive-graph+rid
==
?: =(our.bol ship)

View File

@ -1,334 +1,28 @@
:: chat-store [landscape]:
:: chat-store [landscape]: deprecated
::
:: data store that holds linear sequences of chat messages
::
/- *group, store=chat-store
/+ default-agent, verb, dbug, group-store,
graph-store, resource, *migrate, grpl=group, mdl=metadata
~% %chat-store-top ..part ~
/- store=chat-store
/+ default-agent
|%
+$ card card:agent:gall
+$ versioned-state
$% state-0
state-1
state-2
state-3
state-4
==
::
+$ state-0 [%0 =inbox:store]
+$ state-1 [%1 =inbox:store]
+$ state-2 [%2 =inbox:store]
+$ state-3 [%3 =inbox:store]
+$ state-4 [%4 =inbox:store]
+$ admin-action
$% [%trim ~]
[%migrate-graph ~]
==
--
::
=| state-4
=* state -
::
%- agent:dbug
%+ verb |
^- agent:gall
=<
~% %chat-store-agent-core ..peek-x-envelopes ~
|_ =bowl:gall
+* this .
chat-core +>
cc ~(. chat-core bowl)
def ~(. (default-agent this %|) bowl)
::
++ on-init on-init:def
++ on-save !>(state)
++ on-load
|= old-vase=vase
^- (quip card _this)
|^
=/ old !<(versioned-state old-vase)
=| cards=(list card)
|-
^- (quip card _this)
?- -.old
%4 [cards this(state old)]
::
%3
=. cards :_(cards (poke-admin %migrate-graph ~))
$(old [%4 inbox.old])
::
%2
=/ =inbox:store
(migrate-path-map:group-store inbox.old)
=/ kick-paths
%~ tap in
%+ roll
~(val by sup.bowl)
|= [[=ship sub=path] subs=(set path)]
^- (set path)
?. ?=([@ @ *] sub)
subs
?. &(=(%mailbox i.sub) =('~' i.t.sub))
subs
(~(put in subs) sub)
=? cards ?=(^ kick-paths)
:_ cards
[%give %kick kick-paths ~]
$(old [%3 inbox])
::
?(%0 %1) $(old (old-to-2 inbox.old))
::
==
++ poke-admin
|= =admin-action
^- card
[%pass / %agent [our dap]:bowl %poke noun+!>(admin-action)]
::
++ old-to-2
|= =inbox:store
^- state-2
:- %2
%- ~(run by inbox)
|= =mailbox:store
^- mailbox:store
[config.mailbox (flop envelopes.mailbox)]
--
::
++ on-poke
~/ %chat-store-poke
|= [=mark =vase]
^- (quip card _this)
?> (team:title our.bowl src.bowl)
=^ cards state
?+ mark (on-poke:def mark vase)
%noun (poke-noun:cc !<(admin-action vase))
%import (poke-import:cc q.vase)
==
[cards this]
::
++ on-watch on-watch:def
++ on-leave on-leave:def
++ on-peek
~/ %chat-store-peek
|= =path
^- (unit (unit cage))
?+ path (on-peek:def path)
[%x %all ~] ``noun+!>(inbox)
[%x %keys ~] ``noun+!>(~(key by inbox))
[%x %envelopes *] (peek-x-envelopes:cc t.t.path)
[%x %mailbox *]
?~ t.t.path
~
``noun+!>((~(get by inbox) t.t.path))
::
[%x %config *]
?~ t.t.path
~
=/ mailbox (~(get by inbox) t.t.path)
?~ mailbox
~
``noun+!>(config.u.mailbox)
::
[%x %export ~]
``noun+!>(state)
==
::
++ on-agent on-agent:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
--
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
::
~% %chat-store-library ..card ~
|_ bol=bowl:gall
++ met ~(. mdl bol)
++ grp ~(. grpl bol)
++ on-init on-init:def
++ on-save !>(~)
++ on-load
|= old-vase=vase
^- (quip card _this)
[~ this]
::
++ peek-x-envelopes
|= pax=path
^- (unit (unit [%noun vase]))
?+ pax ~
[@ @ *]
=/ mail-path t.t.pax
=/ mailbox (~(get by inbox) mail-path)
?~ mailbox
[~ ~ %noun !>(~)]
=* envelopes envelopes.u.mailbox
=/ sign-test=[?(%neg %pos) @]
%- need
%+ rush i.pax
;~ pose
%+ cook
|= n=@
[%neg n]
;~(pfix hep dem:ag)
::
%+ cook
|= n=@
[%pos n]
dem:ag
==
=* length length.config.u.mailbox
=* start +.sign-test
?: =(-.sign-test %neg)
?: (gth start length)
[~ ~ %noun !>(envelopes)]
[~ ~ %noun !>((swag [(sub length start) start] envelopes))]
::
=/ end (slav %ud i.t.pax)
?. (lte start end)
~
=. end ?:((lth end length) end length)
[~ ~ %noun !>((swag [start (sub end start)] envelopes))]
==
::
++ poke-noun
|= nou=admin-action
^- (quip card _state)
?: ?=([%migrate-graph ~] nou)
:_ state
(migrate-inbox inbox)
~& %trimming-chat-store
:- ~
%_ state
inbox
%- ~(urn by inbox)
|= [=path mailbox:store]
^- mailbox:store
=/ [a=* out=(list envelope:store)]
%+ roll envelopes
|= $: =envelope:store
o=[[hav=(set serial:store) curr=@] out=(list envelope:store)]
==
?: (~(has in hav.o) uid.envelope)
[[hav.o curr.o] out.o]
:-
^- [(set serial:store) @]
[(~(put in hav.o) uid.envelope) +(curr.o)]
^- (list envelope:store)
[envelope(number curr.o) out.o]
=/ len (lent out)
~? !=(len (lent envelopes)) [path [%old (lent envelopes)] [%new len]]
[[len len] (flop out)]
==
::
++ poke-import
|= arc=*
^- (quip card _state)
=/ sty=state-4 [%4 (remake-map ;;((tree [path mailbox:store]) +.arc))]
:_ sty
(migrate-inbox inbox.sty)
::
++ update-subscribers
|= [pax=path =update:store]
^- (list card)
[%give %fact ~[pax] %chat-update !>(update)]~
::
++ send-diff
|= [pax=path upd=update:store]
^- (list card)
%- zing
:~ (update-subscribers /all upd)
(update-subscribers /updates upd)
(update-subscribers [%mailbox pax] upd)
?. |(|(=(%read -.upd) =(%message -.upd)) =(%messages -.upd))
~
?. |(=(%create -.upd) =(%delete -.upd))
~
(update-subscribers /keys upd)
==
::
++ migrate-inbox
|= =inbox:store
^- (list card)
%- zing
(turn ~(tap by inbox) mailbox-to-updates)
::
++ add-graph
|= [rid=resource =mailbox:store]
%- poke-graph-store
:+ %0 now.bol
:+ %add-graph rid
:- (mailbox-to-graph mailbox)
[`%graph-validator-chat %.y]
::
++ archive-graph
|= rid=resource
%- poke-graph-store
[%0 now.bol %archive-graph rid]
::
++ nobody
^- @p
(bex 128)
::
++ path-to-resource
|= =path
^- resource
?. ?=([@ @ ~] path)
nobody^(spat path)
=/ m-ship=(unit ship)
(slaw %p i.path)
?~ m-ship
nobody^(spat path)
[u.m-ship i.t.path]
::
++ mailbox-to-updates
|= [=path =mailbox:store]
^- (list card)
=/ app-rid=resource
(path-to-resource path)
=/ group-rid=resource
(fall (peek-group:met %graph app-rid) [nobody %bad-group])
=/ group=(unit group)
(scry-group:grp group-rid)
:- (add-graph app-rid mailbox)
?~ group (archive-graph app-rid)^~
?. &(=(~ members.u.group) hidden.u.group) ~
~& >>> "archiving {<app-rid>}"
:~ (archive-graph app-rid)
(remove-group group-rid)
==
::
++ remove-group
|= group=resource
^- card
=- [%pass / %agent [our.bol %group-store] %poke -]
group-update+!>([%remove-group group ~])
::
++ poke-graph-store
|= =update:graph-store
^- card
[%pass / %agent [our.bol %graph-store] %poke %graph-update !>(update)]
::
++ letter-to-contents
|= =letter:store
^- (list content:graph-store)
:_ ~
?. ?=(%me -.letter)
letter
[%text narrative.letter]
::
++ envelope-to-node
|= =envelope:store
^- [atom:graph-store node:graph-store]
=/ contents=(list content:graph-store)
(letter-to-contents letter.envelope)
=/ =index:graph-store
[when.envelope ~]
=, envelope
:- when.envelope
:_ [%empty ~]
^- post:graph-store
:* author
index
when
contents
~ ~
==
::
++ mailbox-to-graph
|= =mailbox:store
^- graph:graph-store
%+ gas:orm:graph-store *graph:graph-store
(turn envelopes.mailbox envelope-to-node)
++ on-poke on-poke:def
++ on-watch on-watch:def
++ on-leave on-leave:def
++ on-peek on-peek:def
++ on-agent on-agent:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
--

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)
@ -69,10 +70,11 @@
::
++ transform-proxy-update
|= vas=vase
^- (unit vase)
^- (quip card (unit vase))
:: TODO: should check if user is allowed to %add, %remove, %edit
:: contact
=/ =update:store !<(update:store vas)
:- ~
?- -.update
%initial ~
%add `vas

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]
@ -126,6 +126,14 @@
!=(contact(last-updated *@da) u.old(last-updated *@da))
==
[~ state]
~| "cannot add a data url to cover!"
?> ?| ?=(~ cover.contact)
!=('data:' (cut 3 [0 5] u.cover.contact))
==
~| "cannot add a data url to avatar!"
?> ?| ?=(~ avatar.contact)
!=('data:' (cut 3 [0 5] u.avatar.contact))
==
:- (send-diff [%add ship contact] =(ship our.bowl))
state(rolodex (~(put by rolodex) ship contact))
::
@ -149,6 +157,14 @@
=/ contact (edit-contact old edit-field)
?: =(old contact)
[~ state]
~| "cannot add a data url to cover!"
?> ?| ?=(~ cover.contact)
!=('data:' (cut 3 [0 5] u.cover.contact))
==
~| "cannot add a data url to avatar!"
?> ?| ?=(~ avatar.contact)
!=('data:' (cut 3 [0 5] u.avatar.contact))
==
=. last-updated.contact timestamp
:- (send-diff [%edit ship edit-field timestamp] =(ship our.bowl))
state(rolodex (~(put by rolodex) ship contact))
@ -203,7 +219,7 @@
?: our
[/updates /our /all ~]
[/updates /all ~]
[%give %fact paths %contact-update !>(update)]~
[%give %fact paths %contact-update-0 !>(update)]~
--
::
++ import
@ -223,7 +239,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
^- (quip card (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

@ -1077,7 +1077,12 @@
::
%thread-done
?> ?=(^ poy)
(~(dy-hand dy u.poy(pux ~)) %noun q.cage.sign)
:: print the vase as a tang if it nests in tang
=/ =mark
?: (~(nest ut -:!>(*tang)) | p.q.cage.sign)
%tang
%noun
(~(dy-hand dy u.poy(pux ~)) mark q.cage.sign)
==
::
%kick +>.$

View File

@ -188,8 +188,11 @@
?: ?=([%'~landscape' %js %session ~] site.req-line)
%+ require-authorization-simple:app
inbound-request
%- js-response:gen
(as-octt:mimes:html "window.ship = '{+:(scow %p our.bowl)}';")
%. %- as-octs:mimes:html
(rap 3 'window.ship = "' (rsh 3 (scot %p our.bowl)) '";' ~)
%* . js-response:gen
cache %.n
==
::
=/ [payload=simple-payload:http public=?] (get-file req-line is-file)
?: public payload
@ -222,6 +225,7 @@
[~ %js] (js-response:gen file)
[~ %css] (css-response:gen file)
[~ %png] (png-response:gen file)
[~ %ico] (ico-response:gen file)
::
[~ %html]
%. file
@ -238,12 +242,10 @@
[not-found:gen %.n]
:_ public.u.content
=/ mime-type=@t (rsh 3 (crip <p.u.data>))
:: Should maybe inspect to see how long cache should hold
::
=/ headers
:~ content-type+mime-type
max-1-da:gen
'Service-Worker-Allowed'^'/'
max-1-wk:gen
'service-worker-allowed'^'/'
==
[[200 headers] `q.u.data]
==

View File

@ -5,7 +5,7 @@
/- glob
/+ default-agent, verb, dbug
|%
++ hash 0v3.o81b7.9dkd7.6ubrn.ebhmi.dtree
++ hash 0v4.vrvkt.4gcnm.dgg5o.e73d6.kqnaq
+$ state-0 [%0 hash=@uv glob=(unit (each glob:glob tid=@ta))]
+$ all-states
$% state-0

View File

@ -9,6 +9,7 @@
update:store
%graph-update
%graph-push-hook
2 2
%.n
==
--
@ -40,9 +41,9 @@
%- (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-2 -]~
!> ^- update:store
[%0 now.bowl [%archive-graph resource]]
[now.bowl [%archive-graph resource]]
::
++ on-pull-kick
|= =resource

View File

@ -1,6 +1,6 @@
/- *group, metadata=metadata-store
/+ store=graph-store, mdl=metadata, res=resource, graph, group, default-agent,
dbug, verb, push-hook
dbug, verb, push-hook, agentio
::
~% %graph-push-hook-top ..part ~
|%
@ -12,43 +12,88 @@
update:store
%graph-update
%graph-pull-hook
2 2
==
::
+$ agent (push-hook:push-hook config)
::
+$ state-null ~
+$ state-zero [%0 marks=(set mark)]
+$ state-one [%1 ~]
+$ versioned-state
$@ state-null
state-zero
$% state-zero
state-one
==
::
:: TODO: come back to this and potentially use send a %t
:: to be notified of validator changes
+$ cache
$: graph-to-mark=(map resource:res (unit mark))
perm-marks=(map [mark @tas] tube:clay)
transform-marks=(map mark tube:clay)
==
::
+$ inflated-state
$: state-one
cache
==
::
+$ cache-action
$% [%graph-to-mark (pair resource:res (unit mark))]
[%perm-marks (pair (pair mark @tas) tube:clay)]
[%transform-marks (pair mark tube:clay)]
==
--
::
=| state-zero
=* state -
%- agent:dbug
%+ verb |
^- agent:gall
%- (agent:push-hook config)
^- agent
=<
=-
~% %graph-push-hook-agent ..scry.hook-core ~
=| inflated-state
=* state -
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
grp ~(. group bowl)
gra ~(. graph bowl)
hc ~(. +> bowl)
met ~(. mdl bowl)
hc ~(. hook-core bowl +.state)
io ~(. agentio bowl)
::
++ on-init on-init:def
++ on-save !>(state)
++ on-save !>(-.state)
++ on-load
|= =vase
=+ !<(old=versioned-state vase)
=? old ?=(~ old)
[%0 ~]
?> ?=(%0 -.old)
`this(state old)
=? old ?=(%0 -.old)
[%1 ~]
?> ?=(%1 -.old)
`this(-.state old, +.state *cache)
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
?. =(mark %graph-cache-hook)
[~ this]
=/ a=cache-action !<(cache-action vase)
=* c +.state
=* graph-to-mark graph-to-mark.c
=* perm-marks perm-marks.c
=* transform-marks transform-marks.c
=. c
?- -.a
%graph-to-mark c(graph-to-mark (~(put by graph-to-mark) p.a q.a))
%perm-marks c(perm-marks (~(put by perm-marks) p.a q.a))
%transform-marks c(transform-marks (~(put by transform-marks) p.a q.a))
==
[~ this(+.state c)]
::
++ on-poke on-poke:def
++ on-agent on-agent:def
++ on-watch on-watch:def
++ on-leave on-leave:def
@ -57,47 +102,72 @@
|= [=wire =sign-arvo]
^- (quip card _this)
?+ wire (on-arvo:def wire sign-arvo)
:: XX: no longer necessary
::
[%perms @ @ ~]
?> ?=(?(%add %remove) i.t.t.wire)
=* mark i.t.wire
:_ this
(build-permissions mark i.t.t.wire %next)^~
::
[%transform-add @ ~]
=* mark i.t.wire
:_ this
(build-transform-add mark %next)^~
[%perms @ @ ~] [~ this]
[%transform-add @ ~] [~ this]
==
::
++ on-fail on-fail:def
++ transform-proxy-update
~/ %transform-proxy-update
|= vas=vase
^- (unit vase)
^- (quip card (unit vase))
=/ =update:store !<(update:store vas)
=* rid resource.q.update
=. p.update now.bowl
?- -.q.update
%add-nodes
?. (is-allowed-add:hc rid nodes.q.update)
~
=/ mark (get-mark:gra rid)
?~ mark `vas
|^
=/ transform
!< $-([index:store post:store atom ?] [index:store post:store])
%. !>(*indexed-post:store)
.^(tube:clay (scry:hc %cc %home /[u.mark]/transform-add-nodes))
=/ [* result=(list [index:store node:store])]
%+ roll
(flatten-node-map ~(tap by nodes.q.update))
(transform-list transform)
=. nodes.q.update
%- ~(gas by *(map index:store node:store))
result
[~ !>(update)]
=| cards=(list card)
=^ allowed cards (is-allowed-add:hc rid nodes.q.update)
?. allowed
[cards ~]
=/ mark-cached (~(has by graph-to-mark) rid)
=/ mark
?: mark-cached
(~(got by graph-to-mark) rid)
(get-mark:gra rid)
?~ mark
[cards `vas]
=< $
~% %transform-add-nodes ..transform-proxy-update ~
|%
++ $
^- (quip card (unit vase))
=/ transform-cached (~(has by transform-marks) u.mark)
=/ =tube:clay
?: transform-cached
(~(got by transform-marks) u.mark)
.^(tube:clay (scry:hc %cc %home /[u.mark]/transform-add-nodes))
=/ transform
!< $-([index:store post:store atom ?] [index:store post:store])
%. !>(*indexed-post:store)
tube
=/ [* result=(list [index:store node:store])]
%+ roll
(flatten-node-map ~(tap by nodes.q.update))
(transform-list transform)
=. nodes.q.update
%- ~(gas by *(map index:store node:store))
result
:_ [~ !>(update)]
%+ weld cards
%- zing
:~ ?: mark-cached ~
:_ ~
%+ poke-self:pass:io %graph-cache-hook
!> ^- cache-action
[%graph-to-mark rid mark]
::
?: transform-cached ~
:_ ~
%+ poke-self:pass:io %graph-cache-hook
!> ^- cache-action
[%transform-marks u.mark tube]
==
::
++ flatten-node-map
~/ %flatten-node-map
|= lis=(list [index:store node:store])
^- (list [index:store node:store])
|^
@ -129,10 +199,13 @@
--
::
++ transform-list
~/ %transform-list
|= transform=$-([index:store post:store atom ?] [index:store post:store])
|= $: [=index:store =node:store]
[indices=(set index:store) lis=(list [index:store node:store])]
==
~| "cannot put a deleted post into %add-nodes {<post.node>}"
?> ?=(%& -.post.node)
=/ l (lent index)
=/ parent-modified=?
%- ~(rep in indices)
@ -143,36 +216,42 @@
%.n
=((swag [0 k] index) i)
=/ [ind=index:store =post:store]
(transform index post.node now.bowl parent-modified)
(transform index p.post.node now.bowl parent-modified)
:- (~(put in indices) index)
(snoc lis [ind node(post post)])
(snoc lis [ind node(p.post post)])
--
::
%remove-nodes
?. (is-allowed-remove:hc resource.q.update indices.q.update)
%remove-posts
=| cards=(list card)
=^ allowed cards
(is-allowed-remove:hc rid indices.q.update)
:- cards
?. allowed
~
`vas
::
%add-graph ~
%remove-graph ~
%add-signatures ~
%remove-signatures ~
%archive-graph ~
%unarchive-graph ~
%add-tag ~
%remove-tag ~
%keys ~
%tags ~
%tag-queries ~
%run-updates ~
%add-graph [~ ~]
%remove-graph [~ ~]
%add-signatures [~ ~]
%remove-signatures [~ ~]
%archive-graph [~ ~]
%unarchive-graph [~ ~]
%add-tag [~ ~]
%remove-tag [~ ~]
%keys [~ ~]
%tags [~ ~]
%tag-queries [~ ~]
%run-updates [~ ~]
==
::
++ resource-for-update resource-for-update:gra
::
++ initial-watch
~/ %initial-watch
|= [=path =resource:res]
^- vase
?> (is-allowed:hc resource)
|^
?> (is-allowed resource)
!> ^- update:store
?~ path
:: new subscribe
@ -184,23 +263,20 @@
(get-graph:gra resource)
=/ =time (slav %da i.path)
=/ =update-log:store (get-update-log-subset:gra resource time)
[%0 now.bowl [%run-updates resource update-log]]
[now.bowl [%run-updates resource update-log]]
::
++ is-allowed
|= =resource:res
=/ group-res=resource:res
(need (peek-group:met %graph resource))
(is-member:grp src.bowl group-res)
--
::
++ take-update
|= =vase
^- [(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)
(build-transform-add:hc mark %sing)
==
::
%remove-graph
:_ this
[%give %kick ~[resource+(en-path:res resource.q.update)] ~]~
@ -210,10 +286,14 @@
[%give %kick ~[resource+(en-path:res resource.q.update)] ~]~
==
--
|_ =bowl:gall
::
~% %graph-push-hook-helper ..card.hook-core ~
^= hook-core
|_ [=bowl:gall =cache]
+* grp ~(. group bowl)
met ~(. mdl bowl)
gra ~(. graph bowl)
io ~(. agentio bowl)
::
++ scry
|= [care=@t desk=@t =path]
@ -221,28 +301,46 @@
/[care]/(scot %p our.bowl)/[desk]/(scot %da now.bowl)
path
::
++ 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)
^- [permissions:store (list card)]
|^
=/ mark-cached (~(has by graph-to-mark.cache) resource)
=/ mark
?: mark-cached
(~(got by graph-to-mark.cache) resource)
(get-mark:gra resource)
?~ mark
[[%no %no %no] ~]
=/ key [u.mark (perm-mark-name perm)]
=/ perms-cached (~(has by perm-marks.cache) key)
=/ =tube:clay
?: perms-cached
(~(got by perm-marks.cache) key)
.^(tube:clay (scry %cc %home /[u.mark]/(perm-mark-name perm)))
=/ check
!< $-(vip-metadata:metadata permissions:store)
(tube !>(indexed-post))
:- (check vip)
%- zing
:~ ?: mark-cached ~
:_ ~
%+ poke-self:pass:io %graph-cache-hook
!> ^- cache-action
[%graph-to-mark resource mark]
::
?: perms-cached ~
:_ ~
%+ poke-self:pass:io %graph-cache-hook
!> ^- cache-action
[%perm-marks [u.mark (perm-mark-name perm)] tube]
==
::
++ perm-mark-name
|= perm=@t
^- @t
(cat 3 'graph-permissions-' perm)
--
::
++ get-permission
|= [=permissions:store is-admin=? writers=(set ship)]
@ -255,22 +353,23 @@
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
~/ %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)
(peek-association:met %graph resource)
?~ assoc ~
=/ group=(unit group:grp)
(scry-group:grp group.u.assoc)
?~ group ~
=/ role=(unit (unit role-tag))
(role-for-ship:grp group.u.assoc src.bowl)
(role-for-ship-with-group:grp u.group group.u.assoc src.bowl)
=/ writers=(set ship)
(get-tagged-ships:grp group.u.assoc [%graph resource %writers])
%^ get-tagged-ships-with-group:grp
u.group
group.u.assoc
[%graph resource %writers]
?~ role ~
=/ is-admin=?
?=(?([~ %admin] [~ %moderator]) u.role)
@ -279,73 +378,111 @@
++ node-to-indexed-post
|= =node:store
^- indexed-post:store
=* index index.post.node
[(snag (dec (lent index)) index) post.node]
?> ?=(%& -.post.node)
=* index index.p.post.node
[(snag (dec (lent index)) index) p.post.node]
::
++ is-allowed-add
~/ %is-allowed-add
|= [=resource:res nodes=(map index:store node:store)]
^- ?
%- (bond |.(%.n))
^- [? (list card)]
|^
%- (bond |.([%.n ~]))
%+ biff (get-roles-writers-variation resource)
|= [is-admin=? writers=(set ship) vip=vip-metadata:metadata]
^- (unit [? (list card)])
%- some
%+ levy ~(tap by nodes)
|= [=index:store =node:store]
?. =(author.post.node src.bowl)
%.n
=/ =permissions:store
%^ add-mark resource vip
(node-to-indexed-post node)
=/ =permission-level:store
(get-permission permissions is-admin writers)
?- 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)
==
=/ a ~(tap by nodes)
=| cards=(list card)
|- ^- [? (list card)]
?~ a [& cards]
=/ c (check i.a is-admin writers vip)
?. -.c
[| (weld cards +.c)]
$(a t.a, cards (weld cards +.c))
::
++ check
|= $: [=index:store =node:store]
is-admin=?
writers=(set ship)
vip=vip-metadata:metadata
==
^- [? (list card)]
=/ parent-index=index:store
(scag (dec (lent index)) index)
?: (~(has by nodes) parent-index)
[%.y ~]
?: ?=(%| -.post.node)
[%.n ~]
?. =(author.p.post.node src.bowl)
[%.n ~]
=/ added
%^ add-mark resource vip
(node-to-indexed-post node)
=* permissions -.added
=* cards +.added
=/ =permission-level:store
(get-permission permissions is-admin writers)
:_ cards
?- permission-level
%yes %.y
%no %.n
::
%self
=/ parent-node=node:store
(got-node:gra resource parent-index)
?: ?=(%| -.post.parent-node)
%.n
=(author.p.post.parent-node src.bowl)
==
::
++ add-mark
|= [=resource:res vip=vip-metadata:metadata =indexed-post:store]
(perm-mark resource %add vip indexed-post)
--
::
++ is-allowed-remove
~/ %is-allowed-remove
|= [=resource:res indices=(set index:store)]
^- ?
%- (bond |.(%.n))
^- [? (list card)]
|^
%- (bond |.([%.n ~]))
%+ biff (get-roles-writers-variation resource)
|= [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]
::
++ build-transform-add
|= [=mark mode=?(%sing %next)]
^- card
=/ =wire /transform-add/[mark]
=/ =mood:clay [%c da+now.bowl /[mark]/transform-add-nodes]
=/ =rave:clay ?:(?=(%sing mode) [mode mood] [mode mood])
[%pass wire %arvo %c %warp our.bowl %home `rave]
=/ a ~(tap by indices)
=| cards=(list card)
|- ^- [? (list card)]
?~ a [& cards]
=/ c (check i.a is-admin writers vip)
?. -.c
[| (weld cards +.c)]
$(a t.a, cards (weld cards +.c))
::
++ check
|= [=index:store is-admin=? writers=(set ship) vip=vip-metadata:metadata]
^- [? (list card)]
=/ =node:store
(got-node:gra resource index)
?: ?=(%| -.post.node)
[%.n ~]
=/ removed
%^ remove-mark resource vip
(node-to-indexed-post node)
=* permissions -.removed
=* cards +.removed
=/ =permission-level:store
(get-permission permissions is-admin writers)
:_ cards
?- permission-level
%yes %.y
%no %.n
%self =(author.p.post.node src.bowl)
==
::
++ remove-mark
|= [=resource:res vip=vip-metadata:metadata =indexed-post:store]
(perm-mark resource %remove vip indexed-post)
--
--

File diff suppressed because it is too large Load Diff

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)
@ -36,84 +37,19 @@
++ on-init on-init:def
++ on-save !>(~)
++ on-load on-load:def
++ on-poke
|= [=mark =vase]
^- (quip card _this)
|^
?. =(mark %sane)
(on-poke:def mark vase)
[(sane !<(?(%check %fix) vase)) this]
::
++ scry-sharing
.^ (set resource)
%gx
(scot %p our.bowl)
%group-push-hook
(scot %da now.bowl)
/sharing/noun
==
::
++ sane
|= input=?(%check %fix)
^- (list card)
=; cards=(list card)
?: =(%check input)
~&(cards ~)
cards
%+ 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) (~(gas in subs) our.bowl ~))
?~ 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
++ on-peek on-peek:def
++ on-arvo on-arvo:def
++ on-fail on-fail: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)
^- (quip card (unit vase))
=/ =update:store !<(update:store vas)
:- ~
?: ?=(%initial -.update)
~
|^

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
@ -414,11 +414,8 @@
?> ?& ?=(~ (~(dif in ships) members))
(~(has by tags) tag)
==
%= +<
::
tags
%+ ~(jab by tags) tag
|=((set ship) (~(dif in +<) ships))
%= +<
tags (dif-ju tags tag ships)
==
:_ state
(send-diff %remove-tag rid tag ships)
@ -543,7 +540,15 @@
(send-diff %remove-group rid ~)
::
--
:: TODO: move to +zuse
++ dif-ju
|= [=tags =tag remove=(set ship)]
=/ ships ~(tap in remove)
|-
?~ ships
tags
$(tags (~(del ju tags) tag i.ships), ships t.ships)
::
++ merge-tags
|= [=tags ships=(set ship) new-tags=(set tag)]
^+ tags
@ -583,6 +588,6 @@
++ send-diff
|= =update:store
^- (list card)
[%give %fact ~[/groups] %group-update !>(update)]~
[%give %fact ~[/groups] %group-update-0 !>(update)]~
::
--

View File

@ -4,23 +4,30 @@
|%
++ card card:agent:gall
::
+$ base-state
+$ base-state-0
joining=(map rid=resource [=ship =progress:view])
::
+$ base-state-1
joining=(map rid=resource request:view)
::
+$ state-zero
[%0 base-state]
[%0 base-state-0]
::
+$ state-one
[%1 base-state]
[%1 base-state-0]
::
+$ state-two
[%2 base-state-1]
::
+$ versioned-state
$% state-zero
state-one
state-two
==
::
++ view view-sur
--
=| state-one
=| state-two
=* state -
::
%- agent:dbug
@ -41,10 +48,29 @@
|= =vase
=+ !<(old=versioned-state vase)
=| cards=(list card)
|-
?: ?=(%1 -.old)
`this(state old)
$(-.old %1, cards :_(cards (poke-self:pass:io noun+!>(%cleanup))))
|^
?- -.old
%2 [cards this(state old)]
%1 $(-.old %2, +.old (base-state-to-1 +.old))
%0 $(-.old %1, cards :_(cards (poke-self:pass:io noun+!>(%cleanup))))
==
::
++ base-state-to-1
|= base-state-0
%- ~(gas by *(map resource request:view))
(turn ~(tap by joining) request-to-1)
::
++ request-to-1
|= [rid=resource =ship =progress:view]
^- [resource request:view]
:- rid
%* . *request:view
started now.bowl
hidden %.n
ship ship
progress progress
==
--
::
++ on-poke
|= [=mark =vase]
@ -56,9 +82,11 @@
?. ?=(%group-view-action mark)
(on-poke:def mark vase)
=+ !<(=action:view vase)
?> ?=(%join -.action)
=^ cards state
jn-abet:(jn-start:join:gc +.action)
?+ -.action !!
%join jn-abet:(jn-start:join:gc +.action)
%hide (hide:gc +.action)
==
[cards this]
::
++ on-watch
@ -69,8 +97,7 @@
:_ ~
%+ fact:io
:- %group-view-update
!> ^- update:view
[%initial (~(run by joining) |=([=ship =progress:view] progress))]
!>(`update:view`[%initial joining])
~
==
::
@ -97,6 +124,11 @@
++ grp ~(. grpl bowl)
++ io ~(. agentio bowl)
++ con ~(. conl bowl)
++ hide
|= rid=resource
^- (quip card _state)
:- (fact:io group-view-update+!>([%hide rid]) /all ~)^~
state(joining (~(jab by joining) rid |=(request:view +<(hidden %.y))))
::
++ has-joined
|= rid=resource
@ -107,10 +139,10 @@
::
++ poke-noun
^- (quip card _state)
=; new-joining=(map resource [ship progress:view])
=; new-joining=(map resource request:view)
`state(joining new-joining)
%+ roll ~(tap by joining)
|= [[rid=resource =ship =progress:view] out=_joining]
|= [[rid=resource =request:view] out=_joining]
?. (has-joined rid) out
(~(del by out) rid)
::
@ -128,7 +160,7 @@
++ tx-progress
|= =progress:view
=. joining
(~(put by joining) rid [ship progress])
(~(jab by joining) rid |=(request:view +<(progress progress)))
=; =cage
(emit (fact:io cage /all tx+(en-path:resource rid) ~))
group-view-update+!>([%progress rid progress])
@ -145,9 +177,9 @@
::
++ jn-abed
|= r=resource
=/ [s=^ship =progress:view]
=/ =request:view
(~(got by joining) r)
jn-core(rid r, ship s)
jn-core(rid r, ship ship.request)
::
++ jn-abet
^- (quip card _state)
@ -158,15 +190,20 @@
^+ jn-core
?< (~(has by joining) rid)
=. joining
(~(put by joining) rid [ship %start])
(~(put by joining) rid [%.n now.bowl ship %start])
=. jn-core
(jn-abed rid)
=. jn-core
%- emit
%+ fact:io
group-view-update+!>([%started rid (~(got by joining) rid)])
~[/all]
?< ~|("already joined {<rid>}" (has-joined rid))
=. jn-core
%- 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
@ -227,7 +264,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
@ -246,12 +283,27 @@
::
++ md-fact
|= [=mark =vase]
?. ?=(%metadata-update mark) jn-core
?. ?=(%metadata-update-1 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
?. hidden:(need (scry-group:grp rid))
=/ list-md=(list [=md-resource:metadata =association:metadata])
%+ skim ~(tap by associations.update)
|= [=md-resource:metadata =association:metadata]
=(app-name.md-resource %groups)
?> ?=(^ list-md)
=* metadatum metadatum.association.i.list-md
?. ?& ?=(%group -.config.metadatum)
?=(^ feed.config.metadatum)
?=(^ u.feed.config.metadatum)
==
jn-core
=* feed resource.u.u.feed.config.metadatum
%- emit
%+ poke-our:(jn-pass-io /pull-feed) %graph-pull-hook
pull-hook-action+!>([%add [entity .]:feed])
%- emit-many
%+ murn ~(tap by associations.update)
|= [=md-resource:metadata =association:metadata]

View File

@ -24,7 +24,6 @@
watch-on-self=_&
==
::
::
++ scry
|* [[our=@p now=@da] =mold p=path]
?> ?=(^ p)
@ -37,7 +36,6 @@
%^ scry [our now]
tube:clay
/cc/[desk]/[mark]/notification-kind
::
--
::
=| state-1
@ -126,15 +124,15 @@
::
++ poke-noun
|= non=*
?> ?=(%rewatch-dms non)
=/ graphs=(list resource)
~(tap in get-keys:gra)
:- ~
%_ state
watching
%- ~(gas in watching)
(murn graphs |=(rid=resource ?:((should-watch:ha rid) `[rid ~] ~)))
==
[~ state]
:: ?> ?=(%rewatch-dms non)
:: =/ graphs=(list resource)
:: ~(tap in get-keys:gra)
:: %_ state
:: watching
:: %- ~(gas in watching)
:: (murn graphs |=(rid=resource ?:((should-watch:ha rid) `[rid ~] ~)))
:: ==
::
++ hark-graph-hook-action
|= =action:hook
@ -182,7 +180,7 @@
~[watch-graph:ha]
::
%fact
?. ?=(%graph-update p.cage.sign)
?. ?=(%graph-update-2 p.cage.sign)
(on-agent:def wire sign)
=^ cards state
(graph-update !<(update:graph-store q.cage.sign))
@ -197,18 +195,20 @@
::
?(%remove-graph %archive-graph)
(remove-graph resource.q.update)
::
%remove-nodes
(remove-nodes resource.q.update indices.q.update)
::
::
%remove-posts
(remove-posts resource.q.update indices.q.update)
::
%add-nodes
=* rid resource.q.update
(check-nodes ~(val by nodes.q.update) rid)
=/ assoc=(unit association:metadata)
(peek-association:met %graph rid)
(check-nodes ~(val by nodes.q.update) rid assoc)
==
:: this is awful, but notification kind should always switch
:: on the index, so hopefully doesn't matter
:: TODO: rethink this
++ remove-nodes
++ remove-posts
|= [rid=resource indices=(set index:graph-store)]
=/ to-remove
%- ~(gas by *(set [resource index:graph-store]))
@ -257,27 +257,30 @@
(get-graph-mop:gra rid)
=/ node=(unit node:graph-store)
(bind (peek:orm:graph-store graph) |=([@ =node:graph-store] node))
=/ assoc=(unit association:metadata)
(peek-association:met %graph rid)
=^ cards state
(check-nodes (drop node) rid)
?. (should-watch:ha rid)
(check-nodes (drop node) rid assoc)
?. (should-watch:ha rid assoc)
[cards state]
:_ state(watching (~(put in watching) [rid ~]))
(weld cards (give:ha ~[/updates] %listen [rid ~]))
::
::
++ check-nodes
|= $: nodes=(list node:graph-store)
rid=resource
assoc=(unit association:metadata)
==
=/ group=(unit resource)
(peek-group:met %graph rid)
?~ group
~& no-group+rid
?~ assoc
~& no-assoc+rid
`state
=/ metadatum=(unit metadatum:metadata)
(peek-metadatum:met %graph rid)
?~ metadatum `state
abet:check:(abed:handle-update:ha rid nodes u.group module.u.metadatum)
=* group group.u.assoc
=* metadatum metadatum.u.assoc
=/ module=term
?: ?=(%empty -.config.metadatum) %$
?: ?=(%group -.config.metadatum) %$
module.config.metadatum
abet:check:(abed:handle-update:ha rid nodes group module)
--
::
++ on-peek on-peek:def
@ -339,12 +342,11 @@
$(contents t.contents)
::
++ should-watch
|= rid=resource
|= [rid=resource assoc=(unit association:metadata)]
^- ?
=/ group-rid=(unit resource)
(peek-group:met %graph rid)
?~ group-rid %.n
?| !(is-managed:grp u.group-rid)
?~ assoc
%.n
?| !(is-managed:grp group.u.assoc)
&(watch-on-self =(our.bowl entity.rid))
==
::
@ -363,7 +365,9 @@
update-core(rid r, updates upds, group grp, module mod)
::
++ get-conversion
(^get-conversion rid)
:: LA: this tube should be cached in %hark-graph-hook state
:: instead of just trying to keep it warm, as the scry overhead is large
~+ (^get-conversion rid)
::
++ abet
^- (quip card _state)
@ -413,30 +417,34 @@
|= =node:graph-store
^+ update-core
=. update-core (check-node-children node)
?: ?=(%| -.post.node)
update-core
=* pos p.post.node
=+ !< notif-kind=(unit notif-kind:hook)
(get-conversion !>([0 post.node]))
%- get-conversion
!>(`indexed-post:graph-store`[0 pos])
?~ notif-kind
update-core
=/ desc=@t
?: (is-mention contents.post.node)
?: (is-mention contents.pos)
%mention
name.u.notif-kind
=* not-kind u.notif-kind
=/ parent=index:post
(scag parent.index-len.not-kind index.post.node)
(scag parent.index-len.not-kind index.pos)
=/ notif-index=index:store
[%graph group rid module desc parent]
?: =(our.bowl author.post.node)
?: =(our.bowl author.pos)
(self-post node notif-index not-kind)
=. update-core
(update-unread-count not-kind notif-index [time-sent index]:post.node)
(update-unread-count not-kind notif-index [time-sent index]:pos)
=? update-core
?| =(desc %mention)
(~(has in watching) [rid parent])
==
=/ =contents:store
[%graph (limo post.node ~)]
(add-unread notif-index [time-sent.post.node %.n contents])
[%graph (limo pos ~)]
(add-unread notif-index [time-sent.pos %.n contents])
update-core
::
++ update-unread-count
@ -455,20 +463,19 @@
=notif-kind:hook
==
^+ update-core
?: ?=(%none mode.notif-kind) update-core
?> ?=(%& -.post.node)
=/ =stats-index:store
(to-stats-index:store index)
=. update-core
(hark %seen-index time-sent.post.node stats-index)
(hark %seen-index time-sent.p.post.node stats-index)
=? update-core ?=(%count mode.notif-kind)
(hark %read-count stats-index)
=? update-core watch-on-self
(new-watch index.post.node [watch-for index-len]:notif-kind)
(new-watch index.p.post.node [watch-for index-len]:notif-kind)
update-core
::
++ add-unread
|= [=index:store =notification:store]
(hark %add-note index notification)
::
--
--

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-1
=^ cards state
(metadata-update !<(update:metadata q.cage.sign))
[cards this]

View File

@ -24,6 +24,7 @@
state-3
state-4
state-5
state-6
==
+$ unread-stats
[indices=(set index:graph-store) last=@da]
@ -45,13 +46,16 @@
[%3 state-two:store]
::
+$ state-4
[%4 base-state]
[%4 state-three:store]
::
+$ state-5
[%5 base-state]
[%5 state-three:store]
::
+$ state-6
[%6 base-state]
::
+$ inflated-state
$: state-5
$: state-6
cache
==
:: $cache: useful to have precalculated, but can be derived from state
@ -92,9 +96,16 @@
=| cards=(list card)
|^
?- -.old
%5
%6
:- (flop cards)
this(-.state old, +.state (inflate-cache:ha old))
::
%5
%_ $
-.old %6
notifications.old (convert-notifications-4 notifications.old)
archive.old (convert-notifications-4 archive.old)
==
::
%4
%_ $
@ -149,15 +160,59 @@
==
==
::
++ convert-notifications-3
|= old=notifications:state-two:store
++ convert-notifications-4
|= old=notifications:state-three:store
%+ gas:orm *notifications:store
^- (list [@da timebox:store])
%+ murn
(tap:orm:state-two:store old)
|= [time=@da =timebox:state-two:store]
(tap:orm:state-three:store old)
|= [time=@da =timebox:state-three:store]
^- (unit [@da timebox:store])
=/ new-timebox=timebox:store
(convert-timebox-4 timebox)
?: =(0 ~(wyt by new-timebox))
~
`[time new-timebox]
::
++ convert-timebox-4
|= =timebox:state-three:store
^- timebox:store
%- ~(gas by *timebox:store)
^- (list [index:store notification:store])
%+ murn
~(tap by timebox)
|= [=index:store =notification:state-three:store]
^- (unit [index:store notification:store])
=/ new-notification=(unit notification:store)
(convert-notification-4 notification)
?~ new-notification ~
`[index u.new-notification]
::
++ convert-notification-4
|= =notification:state-three:store
^- (unit notification:store)
?: ?=(%group -.contents.notification)
`notification
=/ con=(list post:post)
(convert-graph-contents-4 list.contents.notification)
?: =(~ con) ~
=, notification
`[date read %graph con]
::
++ convert-graph-contents-4
|= con=(list post:post-zero:post)
^- (list post:post)
(turn con post-to-one:upgrade:graph-store)
::
++ convert-notifications-3
|= old=notifications:state-two:store
%+ gas:orm:state-three:store *notifications:state-three:store
^- (list [@da timebox:state-three:store])
%+ murn
(tap:orm:state-two:store old)
|= [time=@da =timebox:state-two:store]
^- (unit [@da timebox:state-three:store])
=/ new-timebox=timebox:state-three:store
(convert-timebox-3 timebox)
?: =(0 ~(wyt by new-timebox))
~
@ -165,21 +220,21 @@
::
++ convert-timebox-3
|= =timebox:state-two:store
^- timebox:store
%- ~(gas by *timebox:store)
^- (list [index:store notification:store])
^- timebox:state-three:store
%- ~(gas by *timebox:state-three:store)
^- (list [index:state-three:store notification:state-three:store])
%+ murn
~(tap by timebox)
|= [=index:store =notification:state-two:store]
^- (unit [index:store notification:store])
=/ new-notification=(unit notification:store)
^- (unit [index:store notification:state-three:store])
=/ new-notification=(unit notification:state-three:store)
(convert-notification-3 notification)
?~ new-notification ~
`[index u.new-notification]
::
++ convert-notification-3
|= =notification:state-two:store
^- (unit notification:store)
^- (unit notification:state-three:store)
?: ?=(%graph -.contents.notification)
`notification
=/ con=(list group-contents:store)
@ -293,7 +348,7 @@
~(tap by unreads-count)
|= [=stats-index:store count=@ud]
:* stats-index
~(wyt in (~(gut by by-index) stats-index ~))
(~(gut by by-index) stats-index ~)
[%count count]
(~(gut by last-seen) stats-index *time)
==
@ -304,7 +359,7 @@
~(tap by unreads-each)
|= [=stats-index:store indices=(set index:graph-store)]
:* stats-index
~(wyt in (~(gut by by-index) stats-index ~))
(~(gut by by-index) stats-index ~)
[%each indices]
(~(gut by last-seen) stats-index *time)
==
@ -317,7 +372,7 @@
~
:- ~
:* stats-index
~(wyt in nots)
nots
[%count 0]
*time
==
@ -778,7 +833,7 @@
==
::
++ inflate-cache
|= state-5
|= state-6
^+ +.state
=. +.state
*cache

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.beee3f473ccb51b21245.js"></script>
<script src="/~landscape/js/bundle/index.f252a9afb6e952de19c9.js"></script>
</body>
</html>

View File

@ -191,9 +191,14 @@
^- (unit (unit cage))
?. (team:title our.bowl src.bowl) ~
?+ path [~ ~]
[%x %tiles ~] ``noun+!>([tiles tile-ordering])
[%x %first-time ~] ``noun+!>(first-time)
[%x %keys ~] ``noun+!>(~(key by tiles))
[%x %tiles ~] ``noun+!>([tiles tile-ordering])
[%x %first-time ~] ``noun+!>(first-time)
[%x %keys ~] ``noun+!>(~(key by tiles))
::
[%x %runtime-lag ~]
:^ ~ ~ %json
!> ^- json
b+.^(? //(scot %p our.bowl)//(scot %da now.bowl)/zen/lag)
==
::
++ on-arvo

View File

@ -9,19 +9,49 @@
|%
+$ card card:agent:gall
::
+$ group-preview-0
$: group=resource
channels=associations-0
members=@ud
channel-count=@ud
metadatum=metadatum-0
==
::
+$ associations-0
(map md-resource:metadata [group=resource metadatum=metadatum-0])
::
+$ metadatum-0
$: title=cord
description=cord
=color:metadata
date-created=time
creator=ship
module=term
picture=url:metadata
preview=?
vip=vip-metadata:metadata
==
::
++ config
^- config:pull-hook
:* %metadata-store
update:metadata
%metadata-update
%metadata-push-hook
1 1
%.n
==
+$ state-zero
[%0 previews=(map resource group-preview:metadata)]
[%0 previews=(map resource group-preview-0)]
::
+$ state-one
$: %1
pending=(set resource)
previews=(map resource group-preview-0)
==
::
+$ state-two
$: %2
pending=(set resource)
previews=(map resource group-preview:metadata)
==
@ -29,17 +59,16 @@
+$ versioned-state
$% state-zero
state-one
state-two
==
::
--
::
::
%- agent:dbug
%+ verb |
^- agent:gall
%- (agent:pull-hook config)
^- (pull-hook:pull-hook config)
=| state-one
=| state-two
=* state -
=> |_ =bowl:gall
++ def ~(. (default-agent state %|) bowl)
@ -82,7 +111,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 +180,7 @@
%kick [watch-store^~ state]
::
%fact
?> ?=(%metadata-update p.cage.sign)
?> ?=(%metadata-update-1 p.cage.sign)
=+ !<(=update:metadata q.cage.sign)
?. ?=(%initial-group -.update) `state
`state(previews (~(del by previews) group.update))
@ -175,9 +204,17 @@
++ on-load
|= =vase
=+ !<(old=versioned-state vase)
|-
|^
?- -.old
%1 `this(state old)
%2 `this(state old)
::
%1
%_ $
old
%* . *state-two
previews (~(run by previews.old) preview-to-1)
==
==
::
%0
%_ $
@ -187,6 +224,39 @@
==
==
==
::
++ metadatum-to-1
|= m=metadatum-0
%* . *metadatum:metadata
title title.m
description description.m
color color.m
date-created date-created.m
creator creator.m
preview preview.m
hidden %|
::
config
?: =(module.m %$)
[%group ~]
[%graph module.m]
==
::
++ preview-to-1
|= preview=group-preview-0
^- group-preview:metadata
%= preview
metadatum (metadatum-to-1 metadatum.preview)
channels (associations-to-1 channels.preview)
==
::
++ associations-to-1
|= a=associations-0
^- associations:metadata
%- ~(run by a)
|= [g=resource m=metadatum-0]
[g (metadatum-to-1 m)]
--
::
++ on-poke
|= [=mark =vase]
@ -255,7 +325,7 @@
%+ turn ~(tap by associations)
|= [=md-resource:metadata =association:metadata]
%+ poke-our:pass:io %metadata-store
:- %metadata-update
:- %metadata-update-1
!> ^- update:metadata
[%remove resource md-resource]
::

View File

@ -14,6 +14,7 @@
update:store
%metadata-update
%metadata-pull-hook
1 1
==
::
+$ agent (push-hook:push-hook config)
@ -58,22 +59,32 @@
::
++ transform-proxy-update
|= vas=vase
^- (unit vase)
^- (quip card (unit vase))
=/ =update:store !<(update:store vas)
:- ~
?. ?=(?(%add %remove) -.update)
~
=/ role=(unit (unit role-tag))
(role-for-ship:grp group.update src.bowl)
=/ =metadatum:store
(need (peek-metadatum:met %groups group.update))
?~ role ~
=/ metadatum=(unit metadatum:store)
(peek-metadatum:met %groups group.update)
?: ?& ?=(~ metadatum)
(is-managed:grp group.update)
==
~
?: ?& ?=(^ metadatum)
!(is-managed:grp group.update)
==
~
?^ u.role
?: ?=(?(%admin %moderator) u.u.role)
`vas
~
?. ?=(%add -.update) ~
?: ?& =(src.bowl entity.resource.resource.update)
?=(%member-metadata vip.metadatum)
?: ?& ?=(^ metadatum)
=(src.bowl entity.resource.resource.update)
?=(%member-metadata vip.u.metadatum)
==
`vas
~

View File

@ -23,7 +23,7 @@
:: /app-name/%app-name associations for app
:: /group/%path associations for group
::
/- store=metadata-store
/- store=metadata-store, pull-hook
/+ default-agent, verb, dbug, resource, *migrate
|%
+$ card card:agent:gall
@ -64,6 +64,21 @@
resource-indices=(jug md-resource-1 path)
==
::
+$ metadatum-2
$: title=cord
description=cord
=color:store
date-created=time
creator=ship
module=term
picture=url:store
preview=?
vip=vip-metadata:store
==
::
+$ association-2 [group=resource =metadatum-2]
+$ associations-2 (map md-resource:store association-2)
::
+$ cached-indices
$: group-indices=(jug resource md-resource:store)
app-indices=(jug app-name:store [group=resource =resource])
@ -71,18 +86,26 @@
==
::
+$ base-state-2
$: associations=associations-2
~
==
::
+$ base-state-3
$: =associations:store
~
==
::
+$ state-0 [%0 base-state-0]
+$ state-1 [%1 base-state-0]
+$ state-2 [%2 base-state-0]
+$ state-3 [%3 base-state-1]
+$ state-4 [%4 base-state-1]
+$ state-5 [%5 base-state-1]
+$ state-6 [%6 base-state-1]
+$ state-7 [%7 base-state-2]
+$ state-0 [%0 base-state-0]
+$ state-1 [%1 base-state-0]
+$ state-2 [%2 base-state-0]
+$ state-3 [%3 base-state-1]
+$ state-4 [%4 base-state-1]
+$ state-5 [%5 base-state-1]
+$ state-6 [%6 base-state-1]
+$ state-7 [%7 base-state-2]
+$ state-8 [%8 base-state-3]
+$ state-9 [%9 base-state-3]
+$ state-10 [%10 base-state-3]
+$ versioned-state
$% state-0
state-1
@ -92,10 +115,13 @@
state-5
state-6
state-7
state-8
state-9
state-10
==
::
+$ inflated-state
$: state-7
$: state-10
cached-indices
==
--
@ -126,7 +152,7 @@
?> (team:title our.bowl src.bowl)
=^ cards state
?+ mark (on-poke:def mark vase)
?(%metadata-action %metadata-update)
?(%metadata-action %metadata-update-1)
(poke-metadata-update:mc !<(update:store vase))
::
%import
@ -144,7 +170,7 @@
=/ cards=(list card)
?+ path (on-watch:def path)
[%all ~]
(give %metadata-update !>([%associations associations]))
(give %metadata-update-1 !>([%associations associations]))
::
[%updates ~]
~
@ -152,7 +178,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-1 !>([%associations app-indices]))
==
[cards this]
::
@ -208,21 +234,39 @@
=| cards=(list card)
|^
=* loop $
?: ?=(%7 -.old)
?: ?=(%10 -.old)
:- cards
%_ state
associations
associations.old
::
resource-indices
(rebuild-resource-indices associations.old)
::
group-indices
(rebuild-group-indices associations.old)
::
app-indices
(rebuild-app-indices associations.old)
associations associations.old
resource-indices (rebuild-resource-indices associations.old)
group-indices (rebuild-group-indices associations.old)
app-indices (rebuild-app-indices associations.old)
==
?: ?=(%9 -.old)
=/ groups
(fall (~(get by (rebuild-app-indices associations.old)) %groups) ~)
=/ pokes=(list card)
%+ murn ~(tap in ~(key by groups))
|= group=resource
^- (unit card)
=/ =association:store (~(got by associations.old) [%groups group])
=* met metadatum.association
?. ?=([%group [~ [~ [@ [@ @]]]]] config.met)
~
=* res resource.u.u.feed.config.met
?: =(our.bowl entity.res) ~
=- `[%pass /fix-feed %agent [our.bowl %graph-pull-hook] %poke -]
:- %pull-hook-action
!> ^- action:pull-hook
[%add entity.res res]
%_ $
cards (weld cards pokes)
-.old %10
==
?: ?=(%8 -.old)
$(-.old %9)
?: ?=(%7 -.old)
$(old [%8 (associations-2-to-3 associations.old) ~])
?: ?=(%6 -.old)
=/ old-assoc=associations-1
(migrate-app-to-graph-store %chat associations.old)
@ -236,12 +280,37 @@
associations.old associations
==
:: pre-breach, can safely throw away
loop(old *state-7)
loop(old *state-8)
::
++ associations-2-to-3
|= assoc=associations-2
^- associations:store
%- ~(gas by *associations:store)
%+ turn ~(tap by assoc)
|= [m=md-resource:store [g=resource met=metadatum-2]]
[m [g (metadatum-2-to-3 met)]]
::
++ metadatum-2-to-3
|= m=metadatum-2
%* . *metadatum:store
title title.m
description description.m
color color.m
date-created date-created.m
creator creator.m
preview preview.m
hidden %|
::
config
?: =(module.m %$)
[%group ~]
[%graph module.m]
==
::
++ associations-1-to-2
|= assoc=associations-1
^- associations:store
%- ~(gas by *associations:store)
^- associations-2
%- ~(gas by *associations-2)
%+ murn
~(tap by assoc)
|= [[group=path m=md-resource-1] met=metadata-1]
@ -262,7 +331,7 @@
::
++ metadata-1-to-2
|= m=metadata-1
%* . *metadatum:store
%* . *metadatum-2
title title.m
description description.m
color color.m
@ -309,6 +378,8 @@
ship+path.md-resource
[[path [%graph new-path]] m(module app)]
--
::
:: TODO: refactor into a |^ inside the agent core
++ poke-metadata-update
|= upd=update:store
^- (quip card _state)
@ -319,12 +390,13 @@
%initial-group (handle-initial-group +.upd)
==
::
:: TODO: refactor into a |^ inside the agent core
++ poke-import
|= arc=*
^- (quip card _state)
|^
=^ cards state
(on-load !>([%7 (remake-metadata ;;(tree-metadata +.arc))]))
(on-load !>([%9 (remake-metadata ;;(tree-metadata +.arc))]))
:_ state
%+ weld cards
%+ turn ~(tap in ~(key by group-indices))
@ -348,7 +420,7 @@
::
++ remake-metadata
|= tm=tree-metadata
^- base-state-2
^- base-state-3
:* (remake-map associations.tm)
~
==
@ -443,6 +515,6 @@
++ update-subscribers
|= [pax=path =update:store]
^- (list card)
[%give %fact ~[pax] %metadata-update !>(update)]~
[%give %fact ~[pax] %metadata-update-1 !>(update)]~
--
--

View File

@ -12,6 +12,9 @@
$% [%0 observers=(map serial observer:sur)]
[%1 observers=(map serial observer:sur)]
[%2 observers=(map serial observer:sur)]
[%3 observers=(map serial observer:sur)]
[%4 observers=(map serial observer:sur)]
[%5 observers=(map serial observer:sur) warm-cache=_|]
==
::
+$ serial @uv
@ -25,7 +28,7 @@
--
::
%- agent:dbug
=| [%2 observers=(map serial observer:sur)]
=| [%5 observers=(map serial observer:sur) warm-cache=_|]
=* state -
::
^- agent:gall
@ -39,6 +42,8 @@
:~ (act [%watch %invite-store /invitatory/graph %invite-accepted-graph])
(act [%watch %group-store /groups %group-on-leave])
(act [%watch %group-store /groups %group-on-remove-member])
(act [%watch %metadata-store /updates %md-on-add-group-feed])
(act [%warm-cache-all ~])
==
::
++ act
@ -50,8 +55,7 @@
[our.bowl %observe-hook]
%poke
%observe-action
!> ^- action:sur
action
!>(action)
==
--
::
@ -63,20 +67,36 @@
=/ old-state !<(versioned-state old-vase)
=| cards=(list card)
|-
?: ?=(%2 -.old-state)
=. cards
:_ cards
(act [%watch %group-store /groups %group-on-leave])
?- -.old-state
%5
[cards this(state old-state)]
?: ?=(%1 -.old-state)
%4
=. cards
:_ cards
(act [%warm-cache-all ~])
$(old-state [%5 observers.old-state %.n])
::
%3
=. cards
:_ cards
(act [%watch %metadata-store /updates %md-on-add-group-feed])
$(-.old-state %4)
::
%2
=. cards
:_ cards
(act [%watch %group-store /groups %group-on-leave])
$(-.old-state %3)
::
%1
$(-.old-state %2)
=. cards
:_ cards
(act [%watch %group-store /groups %group-on-remove-member])
$(-.old-state %1)
::
%0
=. cards
:_ cards
(act [%watch %group-store /groups %group-on-remove-member])
$(-.old-state %1)
==
::
++ act
|= =action:sur
@ -87,8 +107,7 @@
[our.bowl %observe-hook]
%poke
%observe-action
!> ^- action:sur
action
!>(action)
==
--
::
@ -98,11 +117,19 @@
?> (team:title our.bowl src.bowl)
?. ?=(%observe-action mark)
(on-poke:def mark vase)
|^
=/ =action:sur !<(action:sur vase)
=* observer observer.action
=/ vals (silt ~(val by observers))
?- -.action
%watch
%watch (watch observer vals)
%ignore (ignore observer vals)
%warm-cache-all warm-cache-all
%cool-cache-all cool-cache-all
==
::
++ watch
|= [=observer:sur vals=(set observer:sur)]
?: ?|(=(app.observer %spider) =(app.observer %observe-hook))
~|('we avoid infinite loops' !!)
?: (~(has in vals) observer)
@ -117,7 +144,8 @@
path.observer
==
::
%ignore
++ ignore
|= [=observer:sur vals=(set observer:sur)]
?. (~(has in vals) observer)
~|('cannot remove nonexistent observer' !!)
=/ key (got-by-val observers observer)
@ -130,7 +158,19 @@
%leave
~
==
==
::
++ warm-cache-all
?: warm-cache
~|('cannot warm up cache that is already warm' !!)
:_ this(warm-cache %.y)
=/ =rave:clay [%sing [%t da+now.bowl /mar]]
[%pass /warm-cache %arvo %c %warp our.bowl %home `rave]~
::
++ cool-cache-all
?. warm-cache
~|('cannot cool down cache that is already cool' !!)
[~ this(warm-cache %.n)]
--
::
++ on-agent
|= [=wire =sign:agent:gall]
@ -248,9 +288,48 @@
== ==
--
::
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card _this)
:_ this
?+ wire (on-arvo:def wire sign-arvo)
[%warm-cache ~]
?. warm-cache
~
?> ?=([%clay %writ *] sign-arvo)
=* riot p.sign-arvo
?~ riot
=/ =rave:clay [%next [%t da+now.bowl /mar]]
[%pass /warm-cache %arvo %c %warp our.bowl %home `rave]~
:- =/ =rave:clay [%next [%t q.p.u.riot /mar]]
[%pass /warm-cache %arvo %c %warp our.bowl %home `rave]
%+ turn !<((list path) q.r.u.riot)
|= pax=path
^- card
=. pax (snip (slag 1 pax))
=/ mark=@ta
%+ roll pax
|= [=term mark=term]
?: ?=(%$ mark)
term
:((cury cat 3) mark '-' term)
=/ =rave:clay [%sing %b da+now.bowl /[mark]]
[%pass [%mar mark ~] %arvo %c %warp our.bowl %home `rave]
::
[%mar ^]
?. warm-cache
~
?> ?=([%clay %writ *] sign-arvo)
=* riot p.sign-arvo
=* mark t.wire
?~ riot
~
=/ =rave:clay [%next %b q.p.u.riot mark]
[%pass wire %arvo %c %warp our.bowl %home `rave]~
==
::
++ 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
--

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-2
^- update
[%0 now [%add-graph resource (gas:orm ~ ~) mark overwrite]]
[now [%add-graph resource (gas:orm ~ ~) mark overwrite]]

View File

@ -12,9 +12,9 @@
contents.post contents
==
::
:- %graph-update
:- %graph-update-2
^- update
:+ %0 now
:- now
:+ %add-nodes [our name]
%- ~(gas by *(map index node))
~[[[now]~ [post [%empty ~]]]]
~[[[now]~ [[%& post] [%empty ~]]]]

View File

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

View File

@ -3,8 +3,8 @@
/- *graph-store
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[=term =resource ~] ~]
[[=term =uid ~] ~]
==
:- %graph-update
:- %graph-update-2
^- update
[%0 now [%add-tag term resource]]
[now [%add-tag term uid]]

View File

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

View File

@ -4,7 +4,7 @@
|= $: [now=@da eny=@uvJ bec=beak]
[[=ship graph=term ~] ~]
==
:- %graph-update
:- %graph-update-2
=/ 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-2
=- ~& update=- -
.^(=update:graph-store %cx path)

View File

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

View File

@ -1,10 +1,10 @@
:: graph-store|remove-nodes: remove nodes from a graph at indices
:: graph-store|remove-posts: remove nodes from a graph at indices
::
/- *graph-store
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[=resource indices=(set index) ~] ~]
==
:- %graph-update
:- %graph-update-2
^- update
[%0 now [%remove-nodes resource indices]]
[now [%remove-posts resource indices]]

View File

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

View File

@ -3,8 +3,8 @@
/- *graph-store
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[=term =resource ~] ~]
[[=term =uid ~] ~]
==
:- %graph-update
:- %graph-update-2
^- update
[%0 now [%remove-tag term resource]]
[now [%remove-tag term uid]]

View File

@ -5,6 +5,6 @@
|= $: [now=@da eny=@uvJ =beak]
[[=resource ~] ~]
==
:- %graph-update
:- %graph-update-2
^- update
[%0 now [%unarchive-graph resource]]
[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

@ -3,15 +3,14 @@
:::: /hoon/code/hood/gen
::
/? 310
::
::::
::
:- %say
/- *sole
/+ *generators
:- %ask
|= $: [now=@da eny=@uvJ bec=beak]
[arg=?(~ [%reset ~]) ~]
==
=* our p.bec
:- %helm-code
^- (sole-result [%helm-code ?(~ %reset)])
?~ arg
=/ code=tape
%+ slag 1
@ -20,11 +19,23 @@
=/ step=tape
%+ scow %ud
.^(@ud %j /(scot %p our)/step/(scot %da now)/(scot %p our))
%- %- slog
:~ [%leaf code]
[%leaf (weld "current step=" step)]
[%leaf "use |code %reset to invalidate this and generate a new code"]
==
~
::
%+ print 'use |code %reset to invalidate this and generate a new code'
%+ print leaf+(weld "current step=" step)
%+ print leaf+code
(produce [%helm-code ~])
::
?> =(%reset -.arg)
%reset
%+ print 'continue?'
%+ print 'warning: resetting your code closes all web sessions'
%+ prompt
[%& %project "y/n: "]
%+ parse
;~ pose
(cold %.y (mask "yY"))
(cold %.n (mask "nN"))
==
|= reset=?
?. reset
no-product
(produce [%helm-code %reset])

View File

@ -1,13 +0,0 @@
:: Kiln: clear Gall compiler caches
::
:::: /hoon/wash-gall/hood/gen
::
/? 310
::
::::
!:
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
~ ~
==
[%kiln-wash-gall ~]

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

@ -60,13 +60,14 @@
|= [m=md-resource:md association:md]
::NOTE we only count graphs for now
?. &(=(%graph app-name.m) =(our creator.metadatum)) ~
`[module.metadatum resource.m]
?. ?=(%graph -.config.metadatum) ~
`[module.config.metadatum resource.m]
:: for sanity checks
::
=/ real=(set resource:re)
=/ upd=update:ga
%+ scry update:ga
[%x %graph-store /keys/graph-update]
[%x %graph-store /keys/graph-update-2]
?> ?=(%keys -.q.upd)
resources.q.upd
:: count activity per channel
@ -91,8 +92,11 @@
:- (lent week)
%~ wyt in
%+ roll week
|= [[* [author=ship *] *] a=(set ship)]
(~(put in a) author)
|= [[* mp=maybe-post:ga *] a=(set ship)]
?- -.mp
%| a
%& (~(put in a) author.p.mp)
==
:: render results
::
:- (tac 'the date is ' (scot %da now))

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

@ -1,5 +1,5 @@
/- sur=graph-store, pos=post
/+ res=resource
/+ res=resource, migrate
=< [sur .]
=< [pos .]
=, sur
@ -50,18 +50,17 @@
==
::
++ index
|= i=^index
|= ind=^index
^- json
?: =(~ i) s+'/'
=/ j=^tape ""
|-
?~ i [%s (crip j)]
=/ k=json (numb i.i)
?> ?=(%n -.k)
%_ $
i t.i
j (weld j (weld "/" (trip +.k)))
==
:- %s
?: =(~ ind)
'/'
%+ roll ind
|= [cur=@ acc=@t]
^- @t
=/ num (numb cur)
?> ?=(%n -.num)
(rap 3 acc '/' p.num ~)
::
++ uid
|= u=^uid
@ -78,7 +77,7 @@
%mention (frond %mention (ship ship.c))
%text (frond %text s+text.c)
%url (frond %url s+url.c)
%reference (frond %reference (uid uid.c))
%reference (frond %reference (reference +.c))
%code
%+ frond %code
%- pairs
@ -95,6 +94,36 @@
==
==
::
++ reference
|= ref=^reference
|^
%+ frond -.ref
?- -.ref
%graph (graph +.ref)
%group (group +.ref)
==
::
++ graph
|= [grp=res gra=res idx=^index]
%- pairs
:~ graph+s+(enjs-path:res gra)
group+s+(enjs-path:res grp)
index+(index idx)
==
::
++ group
|= grp=res
s+(enjs-path:res grp)
--
::
++ maybe-post
|= mp=^maybe-post
^- json
?- -.mp
%| s+(scot %ux p.mp)
%& (post p.mp)
==
::
++ post
|= p=^post
^- json
@ -110,11 +139,10 @@
++ update
|= upd=^update
^- json
?> ?=(%0 -.upd)
|^ (frond %graph-update (pairs ~[(encode q.upd)]))
::
++ encode
|= upd=update-0
|= upd=action
^- [cord json]
?- -.upd
%add-graph
@ -136,8 +164,8 @@
[%nodes (nodes nodes.upd)]
==
::
%remove-nodes
:- %remove-nodes
%remove-posts
:- %remove-posts
%- pairs
:~ [%resource (enjs:res resource.upd)]
[%indices (indices indices.upd)]
@ -161,14 +189,14 @@
:- %add-tag
%- pairs
:~ [%term s+term.upd]
[%resource (enjs:res resource.upd)]
[%uid (uid uid.upd)]
==
::
%remove-tag
:- %remove-tag
%- pairs
:~ [%term s+term.upd]
[%resource (enjs:res resource.upd)]
[%uid (uid uid.upd)]
==
::
%archive-graph
@ -190,9 +218,9 @@
:- %tag-queries
%- pairs
%+ turn ~(tap by tag-queries.upd)
|= [=term =resources]
|= [=term uids=(set ^uid)]
^- [cord json]
[term [%a (turn ~(tap in resources) enjs:res)]]
[term [%a (turn ~(tap in uids) uid)]]
==
::
++ graph
@ -212,7 +240,7 @@
|= n=^node
^- json
%- pairs
:~ [%post (post post.n)]
:~ [%post (maybe-post post.n)]
:- %children
?- -.children.n
%empty ~
@ -220,7 +248,6 @@
==
==
::
::
++ nodes
|= m=(map ^index ^node)
^- json
@ -247,15 +274,14 @@
++ update
|= jon=json
^- ^update
:- %0
:- *time
^- update-0
^- action
=< (decode jon)
|%
++ decode
%- of
:~ [%add-nodes add-nodes]
[%remove-nodes remove-nodes]
[%remove-posts remove-posts]
[%add-signatures add-signatures]
[%remove-signatures remove-signatures]
::
@ -307,7 +333,7 @@
::
++ node
%- ot
:~ [%post post]
:~ [%post maybe-post]
[%children internal-graph]
==
::
@ -318,6 +344,15 @@
[%empty ~]
[%graph (graph jon)]
::
++ maybe-post
|= jon=json
^- ^maybe-post
?~ jon !!
?+ -.jon !!
%s [%| (nu jon)]
%o [%& (post jon)]
==
::
++ post
%- ot
:~ [%author (su ;~(pfix sig fed:ag))]
@ -333,10 +368,25 @@
:~ [%mention (su ;~(pfix sig fed:ag))]
[%text so]
[%url so]
[%reference uid]
[%reference reference]
[%code eval]
==
::
++ reference
|^
%- of
:~ graph+graph
group+dejs-path:res
==
::
++ graph
%- ot
:~ group+dejs-path:res
graph+dejs-path:res
index+index
==
--
::
++ tang
|= jon=^json
^- ^tang
@ -359,9 +409,8 @@
:~ expression+so
output+tang
==
::
++ remove-nodes
++ remove-posts
%- ot
:~ [%resource dejs:res]
[%indices (as index)]
@ -397,13 +446,13 @@
++ add-tag
%- ot
:~ [%term so]
[%resource dejs:res]
[%uid uid]
==
::
++ remove-tag
%- ot
:~ [%term so]
[%resource dejs:res]
[%uid uid]
==
::
++ keys
@ -438,4 +487,391 @@
*signatures
==
--
::
++ upgrade
|%
::
:: +two
::
++ marked-graph-to-two
|= [=graph:one m=(unit mark)]
[(graph-to-two graph) m]
::
++ graph-to-two
|= =graph:one
(graph:(upgrade ,post:one ,maybe-post) graph post-to-two)
::
++ post-to-two
|= p=post:one
^- maybe-post
[%& p]
::
::
:: +one
::
++ update-log-to-one
|= =update-log:zero
^- update-log:one
%+ gas:orm-log:one *update-log:one
%+ turn (tap:orm-log:zero update-log)
|= [=time =logged-update:zero]
^- [^time logged-update:one]
:- time
:- p.logged-update
(logged-update-to-one q.logged-update)
::
++ logged-update-to-one
|= upd=logged-update-0:zero
^- logged-action:one
?+ -.upd upd
%add-graph upd(graph (graph-to-one graph.upd))
%add-nodes upd(nodes (~(run by nodes.upd) node-to-one))
==
::
++ node-to-one
|= =node:zero
(node:(upgrade ,post:zero ,post) node post-to-one)
::
++ graph-to-one
|= =graph:zero
(graph:(upgrade ,post:zero ,post) graph post-to-one)
::
++ marked-graph-to-one
|= [=graph:zero m=(unit mark)]
[(graph-to-one graph) m]
::
++ post-to-one
|= p=post:zero
^- post
p(contents (contents-to-one contents.p))
::
++ contents-to-one
|= cs=(list content:zero)
^- (list content)
%+ murn cs
|= =content:zero
^- (unit ^content)
?: ?=(%reference -.content) ~
`content
::
++ upgrade
|* [in-pst=mold out-pst=mold]
=>
|%
++ in-orm
((ordered-map atom in-node) gth)
+$ in-node
[post=in-pst children=in-internal-graph]
+$ in-graph
((mop atom in-node) gth)
+$ in-internal-graph
$~ [%empty ~]
$% [%graph p=in-graph]
[%empty ~]
==
::
++ out-orm
((ordered-map atom out-node) gth)
+$ out-node
[post=out-pst children=out-internal-graph]
+$ out-graph
((mop atom out-node) gth)
+$ out-internal-graph
$~ [%empty ~]
$% [%graph p=out-graph]
[%empty ~]
==
--
|%
::
++ graph
|= $: gra=in-graph
fn=$-(in-pst out-pst)
==
^- out-graph
%+ gas:out-orm *out-graph
^- (list [atom out-node])
%+ turn (tap:in-orm gra)
|= [a=atom n=in-node]
^- [atom out-node]
[a (node n fn)]
::
++ node
|= [nod=in-node fn=$-(in-pst out-pst)]
^- out-node
:- (fn post.nod)
^- out-internal-graph
?: ?=(%empty -.children.nod)
[%empty ~]
[%graph (graph p.children.nod fn)]
--
::
++ zero-load
:: =* infinitely recurses
=, store=zero
=, orm=orm:zero
=, orm-log=orm-log:zero
|%
++ change-revision-graph
|= [=graph:store q=(unit mark)]
^- [graph:store (unit mark)]
|^
:_ q
?+ q graph
[~ %graph-validator-link] convert-links
[~ %graph-validator-publish] convert-publish
==
::
++ convert-links
%+ gas:orm *graph:store
%+ turn (tap:orm graph)
|= [=atom =node:store]
^- [^atom node:store]
:: top-level
::
:+ atom post.node
?: ?=(%empty -.children.node)
[%empty ~]
:- %graph
%+ gas:orm *graph:store
%+ turn (tap:orm p.children.node)
|= [=^atom =node:store]
^- [^^atom node:store]
:: existing comments get turned into containers for revisions
::
:^ atom
post.node(contents ~, hash ~)
%graph
%+ gas:orm *graph:store
:_ ~ :- %0
:_ [%empty ~]
post.node(index (snoc index.post.node atom), hash ~)
::
++ convert-publish
%+ gas:orm *graph:store
%+ turn (tap:orm graph)
|= [=atom =node:store]
^- [^atom node:store]
:: top-level
::
:+ atom post.node
?: ?=(%empty -.children.node)
[%empty ~]
:- %graph
%+ gas:orm *graph:store
%+ turn (tap:orm p.children.node)
|= [=^atom =node:store]
^- [^^atom node:store]
:: existing container for publish note revisions
::
?+ atom !!
%1 [atom node]
%2
:+ atom post.node
?: ?=(%empty -.children.node)
[%empty ~]
:- %graph
%+ gas:orm *graph:store
%+ turn (tap:orm p.children.node)
|= [=^^atom =node:store]
^- [^^^atom node:store]
:+ atom post.node(contents ~, hash ~)
:- %graph
%+ gas:orm *graph:store
:_ ~ :- %1
:_ [%empty ~]
post.node(index (snoc index.post.node atom), hash ~)
==
--
::
++ maybe-unix-to-da
|= =atom
^- @
:: (bex 127) is roughly 226AD
?. (lte atom (bex 127))
atom
(add ~1970.1.1 (div (mul ~s1 atom) 1.000))
::
++ convert-unix-timestamped-node
|= =node:store
^- node:store
=. index.post.node
(convert-unix-timestamped-index index.post.node)
?. ?=(%graph -.children.node)
node
:+ post.node
%graph
(convert-unix-timestamped-graph p.children.node)
::
++ convert-unix-timestamped-index
|= =index:store
(turn index maybe-unix-to-da)
::
++ convert-unix-timestamped-graph
|= =graph:store
%+ gas:orm *graph:store
%+ turn
(tap:orm graph)
|= [=atom =node:store]
^- [^atom node:store]
:- (maybe-unix-to-da atom)
(convert-unix-timestamped-node node)
--
--
++ import
|= [arc=* our=ship]
^- (quip card:agent:gall [%5 network])
|^
=/ sty [%5 (remake-network ;;(tree-network +.arc))]
:_ sty
%+ turn ~(tap by graphs.sty)
|= [rid=resource =marked-graph]
^- card:agent:gall
?: =(our entity.rid)
=/ =cage [%push-hook-action !>([%add rid])]
[%pass / %agent [our %graph-push-hook] %poke cage]
(try-rejoin rid 0)
::
+$ tree-network
$: graphs=tree-graphs
tag-queries=(tree [term (tree uid)])
update-logs=tree-update-logs
archive=tree-graphs
~
==
+$ tree-graphs (tree [resource tree-marked-graph])
+$ tree-marked-graph [p=tree-graph q=(unit ^mark)]
+$ tree-graph (tree [atom tree-node])
+$ tree-node [post=tree-maybe-post children=tree-internal-graph]
+$ tree-internal-graph
$~ [%empty ~]
$% [%graph p=tree-graph]
[%empty ~]
==
+$ tree-update-logs (tree [resource tree-update-log])
+$ tree-update-log (tree [time tree-logged-update])
+$ tree-logged-update
$: p=time
$= q
$% [%add-graph =resource =tree-graph mark=(unit ^mark) ow=?]
[%add-nodes =resource nodes=(tree [index tree-node])]
[%remove-posts =resource indices=(tree index)]
[%add-signatures =uid signatures=tree-signatures]
[%remove-signatures =uid signatures=tree-signatures]
==
==
+$ tree-signatures (tree signature)
+$ tree-maybe-post (each tree-post hash)
+$ tree-post
$: author=ship
=index
time-sent=time
contents=(list content)
hash=(unit hash)
signatures=tree-signatures
==
::
++ remake-network
|= t=tree-network
^- network
:* (remake-graphs graphs.t)
(remake-jug:migrate tag-queries.t)
(remake-update-logs update-logs.t)
(remake-graphs archive.t)
~
==
::
++ remake-graphs
|= t=tree-graphs
^- graphs
%- remake-map:migrate
(~(run by t) remake-marked-graph)
::
++ remake-marked-graph
|= t=tree-marked-graph
^- marked-graph
[(remake-graph p.t) q.t]
::
++ remake-graph
|= t=tree-graph
^- graph
%+ gas:orm *graph
%+ turn ~(tap by t)
|= [a=atom tn=tree-node]
^- [atom node]
[a (remake-node tn)]
::
++ remake-internal-graph
|= t=tree-internal-graph
^- internal-graph
?: ?=(%empty -.t)
[%empty ~]
[%graph (remake-graph p.t)]
::
++ remake-node
|= t=tree-node
^- node
:- (remake-post post.t)
(remake-internal-graph children.t)
::
++ remake-update-logs
|= t=tree-update-logs
^- update-logs
%- remake-map:migrate
(~(run by t) remake-update-log)
::
++ remake-update-log
|= t=tree-update-log
^- update-log
=/ ulm ((ordered-map time logged-update) gth)
%+ gas:ulm *update-log
%+ turn ~(tap by t)
|= [=time tlu=tree-logged-update]
^- [^time logged-update]
[time (remake-logged-update tlu)]
::
++ remake-logged-update
|= t=tree-logged-update
^- logged-update
:- p.t
?- -.q.t
%add-graph
:* %add-graph
resource.q.t
(remake-graph tree-graph.q.t)
mark.q.t
ow.q.t
==
::
%add-nodes
:- %add-nodes
:- resource.q.t
%- remake-map:migrate
(~(run by nodes.q.t) remake-node)
::
%remove-posts
[%remove-posts resource.q.t (remake-set:migrate indices.q.t)]
::
%add-signatures
[%add-signatures uid.q.t (remake-set:migrate signatures.q.t)]
::
%remove-signatures
[%remove-signatures uid.q.t (remake-set:migrate signatures.q.t)]
==
::
++ remake-post
|= t=tree-maybe-post
^- maybe-post
?- -.t
%| t
%& t(signatures.p (remake-set:migrate signatures.p.t))
==
::
++ try-rejoin
|= [rid=resource nack-count=@]
^- card:agent:gall
=/ res-path (en-path:res rid)
=/ wire [%try-rejoin (scot %ud nack-count) res-path]
[%pass wire %agent [entity.rid %graph-push-hook] %watch resource+res-path]
--
--

View File

@ -1,5 +1,5 @@
/- sur=graph-view, store=graph-store
/+ resource, group-store
/+ resource, group-store, metadata-store
^?
=< [sur .]
=, sur
@ -18,6 +18,8 @@
groupify+groupify
eval+so
pending-indices+pending-indices
create-group-feed+create-group-feed
disable-group-feed+disable-group-feed
::invite+invite
==
::
@ -62,6 +64,17 @@
:~ group+dejs:resource
policy+policy:dejs:group-store
==
::
++ create-group-feed
%- ot
:~ resource+dejs:resource
vip+vip:dejs:metadata-store
==
::
++ disable-group-feed
%- ot
:~ resource+dejs:resource
==
--
--
::

View File

@ -19,7 +19,7 @@
%add-graph ~[resource.q.update]
%remove-graph ~[resource.q.update]
%add-nodes ~[resource.q.update]
%remove-nodes ~[resource.q.update]
%remove-posts ~[resource.q.update]
%add-signatures ~[resource.uid.q.update]
%remove-signatures ~[resource.uid.q.update]
%archive-graph ~[resource.q.update]
@ -32,9 +32,51 @@
%run-updates ~[resource.q.update]
==
::
++ upgrade
|* [pst=mold out-pst=mold]
=>
|%
++ orm
((ordered-map atom node) gth)
+$ node
[post=pst children=internal-graph]
+$ graph
((mop atom node) gth)
+$ internal-graph
$~ [%empty ~]
$% [%graph p=graph]
[%empty ~]
==
::
++ out-orm
((ordered-map atom out-node) gth)
+$ out-node
[post=out-pst children=out-internal-graph]
+$ out-graph
((mop atom out-node) gth)
+$ out-internal-graph
$~ [%empty ~]
$% [%graph p=out-graph]
[%empty ~]
==
--
|= $: gra=graph
fn=$-(pst out-pst)
==
^- out-graph
%- gas:out-orm
%+ turn (tap:orm gra)
|= [=atom =node]
:- (fn post.node)
?: ?=(%empty -.children.node)
[%empty ~]
$(gra p.children.node)
::
++ get-graph
|= res=resource
^- update:store
=- -(p *time)
%+ scry-for update:store
/graph/(scot %p entity.res)/[name.res]
::
@ -43,7 +85,6 @@
^- graph:store
=/ =update:store
(get-graph res)
?> ?=(%0 -.update)
?> ?=(%add-graph -.q.update)
graph.q.update
::
@ -54,7 +95,6 @@
%+ weld
/node-siblings/younger/(scot %p entity.res)/[name.res]/all
(turn index (cury scot %ud))
?> ?=(%0 -.update)
?> ?=(%add-nodes -.q.update)
nodes.q.update
::
@ -65,7 +105,6 @@
%+ weld
/node/(scot %p entity.res)/[name.res]
(turn index (cury scot %ud))
?> ?=(%0 -.update)
?> ?=(%add-nodes -.q.update)
?> ?=(^ nodes.q.update)
q.n.nodes.q.update
@ -99,7 +138,6 @@
^- resources
=+ %+ scry-for ,=update:store
/keys
?> ?=(%0 -.update)
?> ?=(%keys -.q.update)
resources.q.update
::

View File

@ -15,6 +15,7 @@
join+join
leave+leave
invite+invite
hide+dejs-path:resource
==
::
++ create
@ -53,6 +54,15 @@
?- -.upd
%initial (initial +.upd)
%progress (progress +.upd)
%started (started +.upd)
%hide s+(enjs-path:resource +.upd)
==
::
++ started
|= [rid=resource req=^request]
%- pairs
:~ resource+s+(enjs-path:resource rid)
request+(request req)
==
::
++ progress
@ -61,13 +71,21 @@
:~ resource+s+(enjs-path:resource rid)
progress+s+prog
==
++ request
|= req=^request
%- pairs
:~ hidden+b+hidden.req
started+(time started.req)
ship+(ship ship.req)
progress+s+progress.req
==
::
++ initial
|= init=(map resource ^progress)
|= init=(map resource ^request)
%- pairs
%+ turn ~(tap by init)
|= [rid=resource prog=^progress]
:_ s+prog
|= [rid=resource req=^request]
:_ (request req)
(enjs-path:resource rid)
--
++ cleanup-md

View File

@ -75,7 +75,12 @@
=/ grp=(unit group)
(scry-group rid)
?~ grp ~
=* group u.grp
(role-for-ship-with-group u.grp rid ship)
::
++ role-for-ship-with-group
|= [grp=group rid=resource =ship]
^- (unit (unit role-tag))
=* group grp
=* policy policy.group
=* tags tags.group
=/ admins=(set ^ship)
@ -106,8 +111,13 @@
^- (set ship)
=/ grp=(unit group)
(scry-group rid)
?~ grp ~
(~(get ju tags.u.grp) tag)
?~ grp ~
(get-tagged-ships-with-group u.grp rid tag)
::
++ get-tagged-ships-with-group
|= [grp=group rid=resource =tag]
^- (set ship)
(~(get ju tags.grp) tag)
::
++ is-managed
|= rid=resource

View File

@ -151,7 +151,7 @@
^- json
%- pairs
:~ unreads+(unread unreads.s)
notifications+(numb notifications.s)
notifications+a+(turn ~(tap in notifications.s) notif-ref)
last+(time last-seen.s)
==
++ added

View File

@ -23,13 +23,13 @@
%+ 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)))
==
:- %: rap 3
(spat (en-path:resource group))
'/'
app-name.md-resource
(spat (en-path:resource resource.md-resource))
~
==
%- pairs
:~ [%group s+(enjs-path:resource group)]
[%app-name s+app-name.md-resource]
@ -46,9 +46,28 @@
[%color s+(scot %ux color.met)]
[%date-created s+(scot %da date-created.met)]
[%creator s+(scot %p creator.met)]
[%module s+module.met]
::
:- %config
?+ -.config.met o+~
%graph
%+ frond %graph
s+module.config.met
::
%group
%+ frond %group
?~ feed.config.met
~
?~ u.feed.config.met
o+~
%- pairs
:~ [%app-name s+app-name.u.u.feed.config.met]
[%resource s+(enjs-path:resource resource.u.u.feed.config.met)]
==
==
::
[%picture s+picture.met]
[%preview b+preview.met]
[%hidden b+hidden.met]
[%vip s+`@t`vip.met]
==
::
@ -145,6 +164,8 @@
%- perk
:~ %reader-comments
%member-metadata
%admin-feed
%host-feed
%$
==
::
@ -156,12 +177,41 @@
[%color nu]
[%date-created (se %da)]
[%creator (su ;~(pfix sig fed:ag))]
[%module so]
[%config config]
[%picture so]
[%preview bo]
[%hidden bo]
[%vip vip]
==
::
++ config
|= jon=^json
^- md-config
?~ jon
[%group ~]
?> ?=(%o -.jon)
?: (~(has by p.jon) %graph)
=/ mod
(~(got by p.jon) %graph)
?> ?=(%s -.mod)
[%graph p.mod]
=/ jin=json
(~(got by p.jon) %group)
:+ %group ~
?~ jin
~
?> ?=(%o -.jin)
?. ?& (~(has by p.jin) 'app-name')
(~(has by p.jin) 'resource')
==
~
=/ app-name=^json (~(got by p.jin) 'app-name')
?> ?=(%s -.app-name)
:+ ~
p.app-name
=/ res=^json (~(got by p.jin) 'resource')
(dejs-path:resource res)
::
++ md-resource
^- $-(json ^md-resource)
%- ot

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,17 +76,52 @@
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
==
::
+$ base-state-3
$: prev-version=@ud
prev-min-version=@ud
base-state-2
==
::
+$ state-0 [%0 base-state-0]
::
+$ state-1 [%1 base-state-0]
::
+$ state-2 [%2 base-state-1]
::
+$ state-3 [%3 base-state-2]
::
+$ state-4 [%4 base-state-3]
::
+$ versioned-state
$% state-0
state-1
state-2
state-3
state-4
==
:: +diplomatic: only renegotiate if versions changed
::
:: If %.n please leave note as to why renegotiation necessary
::
::
++ diplomatic
^- ?
%.y
::
++ default
|* [pull-hook=* =config]
@ -176,7 +214,7 @@
++ agent
|* =config
|= =(pull-hook config)
=| state-2
=| state-4
=* state -
^- agent:gall
=<
@ -185,6 +223,9 @@
og ~(. pull-hook bowl)
hc ~(. +> bowl)
def ~(. (default-agent this %|) bowl)
ver ~(. versioning [bowl [update-mark version min-version]:config])
io ~(. agentio bowl)
pass pass:io
::
++ on-init
^- [(list card:agent:gall) agent:gall]
@ -199,61 +240,49 @@
=| cards=(list card:agent:gall)
|^
?- -.old
%2
%4
=^ og-cards pull-hook
(on-load:og inner-state.old)
=. state old
=^ retry-cards state
retry-failed-kicks
=/ kick=(list card)
?: ?& =(min-version.config prev-min-version.old)
=(version.config prev-version.old)
diplomatic
==
~
(poke-self:pass kick+!>(%kick))^~
:_ this
:(weld cards og-cards retry-cards)
::
:(weld cards og-cards kick)
::
%3 $(old [%4 0 0 +.old])
%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
==
::
++ tracking-to-3
|= trk=(map resource ship)
%- ~(gas by *(map resource track))
%+ turn ~(tap by trk)
|= [=resource =ship]
:- resource
[ship %active ~]
::
++ 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]
--
::
++ on-save
^- vase
=. inner-state
on-save:og
=: inner-state on-save:og
prev-min-version min-version.config
prev-version version.config
==
!>(state)
::
++ on-poke
@ -263,6 +292,13 @@
=^ cards pull-hook
(on-poke:og mark vase)
[cards this]
::
%kick
?> (team:title [our src]:bowl)
=^ [cards=(list card:agent:gall) hook=_pull-hook] state
restart-subs:hc
=. pull-hook hook
[cards this]
::
%sane
?> (team:title [our src]:bowl)
@ -272,8 +308,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 +332,333 @@
=^ 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])
::
++ 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 rid)
=. pull-hook hook
$(subs t.subs, acc-cards (weld acc-cards crds))
::
++ 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)))
%- (slog leaf+"versioned nack for {<rid>} in {<dap.bowl>}" 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)
?. versioned
:: don't process unversioned, unsupported facts
:: just wait for publisher to upgrade and kick the
:: subscription
tr-core
(tr-suspend-pub-ver min-version.config)
=/ =^cage
(convert-to:ver cage)
=/ =wire
(make-wire /store)
=+ resources=(~(gas in *(set resource)) (resource-for-update:og q.cage))
?> ?| 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 cage))
--
::
++ 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]
?< =(s our.bowl)
=: 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 +673,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 +691,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,8 @@
:: foreign push-hook
::
/- *push-hook
/+ default-agent, resource, verb
/+ default-agent, resource, verb, versioning, agentio
~% %push-hook-top ..part ~
|%
+$ card card:agent:gall
::
@ -43,6 +44,8 @@
update=mold
update-mark=term
pull-hook-name=term
version=@ud
min-version=@ud
==
::
:: $base-state-0: state for the push hook
@ -55,15 +58,32 @@
inner-state=vase
==
::
+$ base-state-1
$: prev-version=@ud
prev-min-version=@ud
base-state-0
==
::
+$ state-0 [%0 base-state-0]
::
+$ state-1 [%1 base-state-0]
+$ state-2 [%2 base-state-1]
::
+$ versioned-state
$% state-0
state-1
state-2
==
:: +diplomatic: only renegotiate if versions changed
::
:: If %.n please leave note as to why renegotiation necessary
::
++ diplomatic
^- ?
%.y
::
++ push-hook
~/ %push-hook
|* =config
$_ ^|
|_ bowl:gall
@ -93,7 +113,7 @@
::
++ transform-proxy-update
|~ vase
*(unit vase)
*[(list card) (unit vase)]
:: +initial-watch: produce initial state for a subscription
::
:: .resource is the resource being subscribed to.
@ -151,15 +171,19 @@
++ agent
|* =config
|= =(push-hook config)
=| state-1
=| state-2
=* state -
^- agent:gall
=<
~% %push-agent-lib ..poke-hook-action ~
|_ =bowl:gall
+* this .
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
@ -174,10 +198,22 @@
=| cards=(list card:agent:gall)
|^
?- -.old
%1
%2
=^ og-cards push-hook
(on-load:og inner-state.old)
[(weld cards og-cards) this(state old)]
=/ old-subs
(find-old-subs [prev-version prev-min-version]:old)
=/ version-cards
:- (fact:io version+!>(version.config) /version ~)
?~ old-subs ~
(kick:io old-subs)^~
[:(weld cards og-cards version-cards) this(state old)]
::
%1
%_ $
old [%2 0 0 +.old]
==
::
::
%0
%_ $
@ -192,6 +228,26 @@
==
==
::
++ find-old-subs
|= [prev-min-version=@ud prev-version=@ud]
?: ?& =(min-version.config prev-min-version)
=(prev-version version.config)
diplomatic
==
:: bail on kick if we didn't change versions
~
%~ 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
@ -205,11 +261,14 @@
--
::
++ on-save
=. inner-state
on-save:og
=: prev-version version.config
prev-min-version min-version.config
inner-state on-save:og
==
!>(state)
::
++ on-poke
~/ %on-poke
|= [=mark =vase]
^- (quip card:agent:gall agent:gall)
?: =(mark %push-hook-action)
@ -218,34 +277,53 @@
(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)
[cards this]
::
++ on-watch
~/ %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)
=/ =vase
(initial-watch:og t.t.t.t.path resource)
(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))
:_ this
[%give %fact ~ update-mark.config vase]~
=- [%give %fact ~ -]~
(convert-to:ver mark (initial-watch:og t.t.t.t.t.t.path resource))
::
++ unversioned
?> ?=([%ship @ @ *] t.path)
=/ =resource
(de-path:resource t.path)
=/ =vase
(initial-watch:og t.t.t.t.path resource)
:_ this
?. =(min-version.config 0)
~& >>> "unversioned req from: {<src.bowl>}, nooping"
~
[%give %fact ~ (convert-to:ver update-mark.config vase)]~
--
::
++ on-agent
~/ %on-agent
|= [=wire =sign:agent:gall]
^- (quip card:agent:gall agent:gall)
?. ?=([%helper %push-hook @ *] wire)
@ -258,7 +336,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 +344,7 @@
(take-update:og q.cage.sign)
:_ this
%+ weld
(push-updates:hc q.cage.sign)
(push-updates:hc cage.sign)
cards
==
::
@ -293,23 +371,21 @@
^- (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)
?+ path (on-peek:og path)
[%x %sharing ~] ``noun+!>(sharing)
[%x %version ~] ``version+!>(version.config)
[%x %min-version ~] ``version+!>(version.config)
==
--
~% %push-helper-lib ..card ~
|_ =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
~/ %poke-hook-action
|= =action
^- (quip card:agent:gall _state)
|^
@ -378,48 +454,90 @@
[%pass wire %agent [our.bowl store-name.config] %watch store-path.config]
::
++ push-updates
|= =vase
~/ %push-updates
|= =cage
^- (list card:agent:gall)
=/ rids=(list resource) (resource-for-update vase)
=| cards=(list card:agent:gall)
|-
?~ rids cards
=/ prefix=path
resource+(en-path:resource i.rids)
=/ paths=(list path)
%~ tap in
%- silt
%+ turn
(incoming-subscriptions prefix)
|=([ship pax=path] pax)
?~ paths $(rids t.rids)
%_ $
rids t.rids
cards (snoc cards [%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)
(fact:io (convert-from:ver mark q.cage) ~(tap in paths))
:: TODO: deprecate
++ unversioned
?. =(min-version.config 0) ~
=/ prefix=path
resource+(en-path:resource rid)
=/ unversioned=(set path)
%- ~(gas in *(set path))
(turn (incoming-subscriptions prefix) tail)
?: =(0 ~(wyt in unversioned)) ~
(fact:io (convert-from:ver update-mark.config q.cage) ~(tap in unversioned))^~
--
::
++ forward-update
|= =vase
~/ %forward-update
|= =cage
^- (list card:agent:gall)
=/ rids=(list resource) (resource-for-update vase)
=| cards=(list card:agent:gall)
|-
?~ rids cards
=- lis
=/ vas=vase
q:(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
resource+(en-path:resource i.rids)
=/ =wire
(make-wire resource+(en-path:resource i.rids))
=/ dap=term
?:(=(our.bowl entity.i.rids) store-name.config dap.bowl)
%_ $
rids t.rids
resource+(en-path:resource rid)
=* ship entity.rid
=/ out=(pair (list card:agent:gall) (unit vase))
?. =(our.bowl ship)
:: do not transform before forwarding
::
``vas
:: use cached transform
::
?^ tf-vas `tf-vas
:: transform before poking store
::
(transform-proxy-update:og vas)
~| "forwarding failed during transform. mark: {<p.cage>} rid: {<rid>}"
?> ?=(^ q.out)
:_ q.out
:_ (weld lis p.out)
=/ =wire (make-wire path)
=- [%pass wire %agent - %poke [current-version:ver u.q.out]]
:- ship
?. =(our.bowl ship)
:: forward to host
::
dap.bowl
:: poke our store
::
cards
%+ snoc cards
[%pass wire %agent [entity.i.rids dap] %poke update-mark.config vase]
==
store-name.config
::
++ ver-from-path
|= =path
=/ extra=^path
(slag 5 path)
?> ?=(^ extra)
(slav %ud i.extra)
::
++ resource-for-update
~/ %resource-for-update
|= =vase
^- (list resource)
%~ tap in

View File

@ -39,10 +39,10 @@
~! +:*handler
(handler inbound-request)
::
=/ redirect=cord
%- crip
"/~/login?redirect={(trip url.request.inbound-request)}"
[[307 ['location' redirect]~] ~]
=- [[307 ['location' -]~] ~]
%^ cat 3
'/~/login?redirect='
url.request.inbound-request
::
:: +require-authorization-simple:
:: redirect to the login page when unauthenticated
@ -56,10 +56,10 @@
~! this
simple-payload
::
=/ redirect=cord
%- crip
"/~/login?redirect={(trip url.request.inbound-request)}"
[[307 ['location' redirect]~] ~]
=- [[307 ['location' -]~] ~]
%^ cat 3
'/~/login?redirect='
url.request.inbound-request
::
++ give-simple-payload
|= [eyre-id=@ta =simple-payload:http]
@ -86,36 +86,52 @@
:_ `octs
[200 [['content-type' 'text/html'] ?:(cache [max-1-wk ~] ~)]]
::
++ js-response
|= =octs
^- simple-payload:http
[[200 [['content-type' 'text/javascript'] max-1-da ~]] `octs]
::
++ json-response
|= =json
^- simple-payload:http
[[200 ['content-type' 'application/json']~] `(json-to-octs json)]
::
++ css-response
=| cache=?
|= =octs
^- simple-payload:http
[[200 [['content-type' 'text/css'] max-1-da ~]] `octs]
:_ `octs
[200 [['content-type' 'text/css'] ?:(cache [max-1-wk ~] ~)]]
::
++ manx-response
|= man=manx
++ js-response
=| cache=?
|= =octs
^- simple-payload:http
[[200 ['content-type' 'text/html']~] `(manx-to-octs man)]
:_ `octs
[200 [['content-type' 'text/javascript'] ?:(cache [max-1-wk ~] ~)]]
::
++ png-response
=| cache=?
|= =octs
^- simple-payload:http
[[200 [['content-type' 'image/png'] max-1-wk ~]] `octs]
:_ `octs
[200 [['content-type' 'image/png'] ?:(cache [max-1-wk ~] ~)]]
::
++ ico-response
|= =octs
^- simple-payload:http
[[200 [['content-type' 'image/x-icon'] max-1-wk ~]] `octs]
::
++ woff2-response
=| cache=?
|= =octs
^- simple-payload:http
[[200 [['content-type' 'font/woff2'] max-1-wk ~]] `octs]
::
++ json-response
=| cache=_|
|= =json
^- simple-payload:http
:_ `(json-to-octs json)
[200 [['content-type' 'application/json'] ?:(cache [max-1-da ~] ~)]]
::
++ manx-response
=| cache=_|
|= man=manx
^- simple-payload:http
:_ `(manx-to-octs man)
[200 [['content-type' 'text/html'] ?:(cache [max-1-da ~] ~)]]
::
++ not-found
^- simple-payload:http
[[404 ~] ~]
@ -123,10 +139,10 @@
++ login-redirect
|= =request:http
^- simple-payload:http
=/ redirect=cord
%- crip
"/~/login?redirect={(trip url.request)}"
[[307 ['location' redirect]~] ~]
=- [[307 ['location' -]~] ~]
%^ cat 3
'/~/login?redirect='
url.request
::
++ redirect
|= redirect=cord

View File

@ -30,7 +30,7 @@
?~ lyf %.y
=+ %: jael-scry
,deed=[a=life b=pass c=(unit @ux)]
our %deed now /(scot %p q.signature)/(scot %ud p.signature)
our %deed now /(scot %p q.signature)/(scot %ud r.signature)
==
?. =(a.deed r.signature) %.y
:: verify signature from ship at life

View File

@ -719,7 +719,7 @@
(pure:m tid)
::
+$ thread-result
(each vase [term (list tang)])
(each vase [term tang])
::
++ await-thread
|= [file=term args=vase]
@ -727,14 +727,14 @@
^- form:m
;< =bowl:spider bind:m get-bowl
=/ tid (scot %ta (cat 3 'strand_' (scot %uv (sham file eny.bowl))))
=/ tid (scot %ta (cat 3 'strand_' (scot %uv (sham file eny.bowl))))
=/ poke-vase !>([`tid.bowl `tid file args])
;< ~ bind:m (watch-our /awaiting/[tid] %spider /thread-result/[tid])
;< ~ bind:m (poke-our %spider %spider-start poke-vase)
;< ~ bind:m (sleep ~s0) :: wait for thread to start
;< =cage bind:m (take-fact /awaiting/[tid])
;< ~ bind:m (take-kick /awaiting/[tid])
?+ p.cage ~|([%strange-thread-result p.cage file tid] !!)
%thread-done (pure:m %& q.cage)
%thread-fail (pure:m %| !<([term (list tang)] q.cage))
%thread-fail (pure:m %| !<([term tang] q.cage))
==
--

View File

@ -0,0 +1,55 @@
/+ 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
|= [=mark =vase]
^- cage
:- current-version
?: =(mark current-version)
vase
((tube-to mark) vase)
::
++ 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
|= [=mark =vase]
^- cage
:- mark
?: =(mark current-version)
vase
((tube-from mark) vase)
--

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
--
--

20
pkg/arvo/mar/graph/cache/hook.hoon vendored Normal file
View File

@ -0,0 +1,20 @@
/- metadata=metadata-store, res=resource
|%
+$ cache-action
$% [%graph-to-mark (pair resource:res (unit mark))]
[%perm-marks (pair (pair mark @tas) tube:clay)]
[%transform-marks (pair mark tube:clay)]
==
--
::
|_ act=cache-action
++ grad %noun
++ grow
|%
++ noun act
--
++ grab
|%
++ noun cache-action
--
--

View File

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

View File

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

View File

@ -0,0 +1,19 @@
/+ *graph-store
=* as-octs as-octs:mimes:html
::
|_ upd=update
++ grad %noun
++ grow
|%
++ noun upd
++ json (update:enjs 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

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

View File

@ -1,4 +1,4 @@
/- *post, met=metadata-store
/- *post, met=metadata-store, graph=graph-store, hark=hark-graph-hook
|_ i=indexed-post
++ grow
|%
@ -6,17 +6,20 @@
::
++ graph-permissions-add
|= vip=vip-metadata:met
^- permissions:graph
?+ index.p.i !!
[@ ~] [%yes %yes %no]
==
::
++ graph-permissions-remove
|= vip=vip-metadata:met
^- permissions:graph
?+ index.p.i !!
[@ ~] [%self %self %no]
==
::
++ notification-kind
^- (unit notif-kind:hark)
?+ index.p.i ~
[@ ~] `[%message [0 1] %count %none]
==

View File

@ -1,4 +1,4 @@
/- *post, met=metadata-store
/- *post, met=metadata-store, graph=graph-store, hark=hark-graph-hook
|_ i=indexed-post
++ grow
|%
@ -6,6 +6,7 @@
::
++ graph-permissions-add
|= vip=vip-metadata:met
^- permissions:graph
=/ reader
?=(%reader-comments vip)
?+ index.p.i !!
@ -16,6 +17,7 @@
::
++ graph-permissions-remove
|= vip=vip-metadata:met
^- permissions:graph
=/ reader
?=(%reader-comments vip)
?+ index.p.i !!
@ -25,10 +27,10 @@
==
::
++ notification-kind
^- (unit notif-kind:hark)
?+ index.p.i ~
[@ ~] `[%link [0 1] %each %children]
[@ @ %1 ~] `[%comment [1 2] %count %siblings]
[@ @ @ ~] `[%edit-comment [1 2] %none %none]
==
::
++ transform-add-nodes
@ -53,7 +55,7 @@
:: top-level link post; title and url
::
[@ ~]
?> ?=([[%text @] [%url @] ~] contents.p.ip)
?> ?=([[%text @] $%([%url @] [%reference *]) ~] contents.p.ip)
ip
::
:: comment on link post; container structure

View File

@ -0,0 +1,53 @@
/- *post, met=metadata-store, graph=graph-store, hark=hark-graph-hook
|_ i=indexed-post
++ grow
|%
++ noun i
++ graph-permissions-add
|= vip=vip-metadata:met
^- permissions:graph
?. ?=([@ ~] index.p.i)
[%yes %yes %yes]
?+ vip [%yes %yes %yes]
%admin-feed [%yes %no %no]
%host-feed [%no %no %no]
==
::
++ graph-permissions-remove
|= vip=vip-metadata:met
^- permissions:graph
[%yes %self %self]
:: +notification-kind: don't track unreads, notify on replies
::
++ notification-kind
^- (unit notif-kind:hark)
=/ len (lent index.p.i)
=/ =mode:hark
?:(=(1 len) %count %none)
`[%post [(dec len) len] mode %children]
::
++ transform-add-nodes
|= [=index =post =atom was-parent-modified=?]
^- [^index ^post]
=- [- post(index -)]
?~ index !!
?: ?=([@ ~] index)
[atom ~]
?: was-parent-modified
~|(%cannot-submit-parents-with-prepopulated-children !!)
=/ ind=^index index
(snoc (snip ind) atom)
--
++ grab
|%
:: +noun: validate post
::
++ noun
|= p=*
=/ ip ;;(indexed-post p)
?> ?=(^ contents.p.ip)
ip
--
::
++ grad %noun
--

View File

@ -1,10 +1,11 @@
/- *post, met=metadata-store
/- *post, met=metadata-store, graph=graph-store, hark=hark-graph-hook
|_ i=indexed-post
++ grow
|%
++ noun i
++ graph-permissions-add
|= vip=vip-metadata:met
^- permissions:graph
?+ index.p.i !!
[@ ~] [%yes %yes %no] :: new note
[@ %1 @ ~] [%self %self %no]
@ -14,6 +15,7 @@
::
++ graph-permissions-remove
|= vip=vip-metadata:met
^- permissions:graph
?+ index.p.i !!
[@ ~] [%yes %self %self]
[@ %1 @ @ ~] [%yes %self %self]
@ -24,11 +26,10 @@
:: ignore all containers, only notify on content
::
++ notification-kind
^- (unit notif-kind:hark)
?+ index.p.i ~
[@ %1 %1 ~] `[%note [0 1] %each %children]
[@ %1 @ ~] `[%edit-note [0 1] %none %none]
[@ %2 @ %1 ~] `[%comment [1 3] %count %siblings]
[@ %2 @ @ ~] `[%edit-comment [1 3] %none %none]
==
::
++ transform-add-nodes
@ -54,7 +55,7 @@
--
++ grab
|%
:: +noun: validate publish post
:: +noun: validate publish note
::
++ noun
|= p=*

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)

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

@ -0,0 +1,12 @@
|_ dat=@
++ grow
|%
++ mime [/image/x-icon (as-octs:mimes:html dat)]
--
++ grab
|%
++ mime |=([p=mite q=octs] q.q)
++ noun @
--
++ grad %mime
--

View File

@ -0,0 +1,14 @@
/+ store=metadata-store
|_ =update:zero:store
++ grad %noun
++ grow
|%
++ noun update
++ metadata-update update
--
::
++ grab
|%
++ noun update:zero:store
--
--

View File

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

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