Merge branch 'master' into release/next-sys

This commit is contained in:
fang 2021-04-26 23:13:27 +02:00
commit 6f0a947d1b
No known key found for this signature in database
GPG Key ID: EB035760C1BBA972
337 changed files with 10093 additions and 18402 deletions

View File

@ -35,26 +35,26 @@ name: build
on:
push:
paths:
- 'pkg/arvo'
- 'pkg/docker-image'
- 'pkg/ent'
- 'pkg/ge-additions'
- 'pkg/hs'
- 'pkg/libaes_siv'
- 'pkg/urbit'
- 'bin'
- 'nix'
- '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'
- 'pkg/arvo/**'
- 'pkg/docker-image/**'
- 'pkg/ent/**'
- 'pkg/ge-additions/**'
- 'pkg/hs/**'
- 'pkg/libaes_siv/**'
- 'pkg/urbit/**'
- 'bin/**'
- 'nix/**'
jobs:
urbit:

View File

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

View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1
oid sha256:59285407abdc63642ff71384d922f63f4b2c82b3a0daa3673a861c97c59e292f
size 9729397
oid sha256:f6b5e33e573818120051651c1182163527edbbe0dff0eb6591e12a55cfccb273
size 10486101

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"

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

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

@ -247,7 +247,7 @@
++ add-graph
|= [rid=resource =mailbox:store]
%- poke-graph-store
:+ %0 now.bol
:- now.bol
:+ %add-graph rid
:- (mailbox-to-graph mailbox)
[`%graph-validator-chat %.y]
@ -255,7 +255,7 @@
++ archive-graph
|= rid=resource
%- poke-graph-store
[%0 now.bol %archive-graph rid]
[now.bol %archive-graph rid]
::
++ nobody
^- @p
@ -293,12 +293,12 @@
|= group=resource
^- card
=- [%pass / %agent [our.bol %group-store] %poke -]
group-update+!>([%remove-group group ~])
group-update-0+!>([%remove-group group ~])
::
++ poke-graph-store
|= =update:graph-store
^- card
[%pass / %agent [our.bol %graph-store] %poke %graph-update !>(update)]
[%pass / %agent [our.bol %graph-store] %poke %graph-update-1 !>(update)]
::
++ letter-to-contents
|= =letter:store

View File

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

View File

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

View File

@ -71,7 +71,7 @@
++ give
|= =update:store
^- (list card)
[%give %fact ~ [%contact-update !>(update)]]~
[%give %fact ~ [%contact-update-0 !>(update)]]~
--
::
++ on-poke
@ -81,7 +81,7 @@
|^
=^ cards state
?+ mark (on-poke:def mark vase)
%contact-update (update !<(update:store vase))
%contact-update-0 (update !<(update:store vase))
%import (import q.vase)
==
[cards this]
@ -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
^- (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

@ -243,7 +243,7 @@
=/ headers
:~ content-type+mime-type
max-1-da:gen
'Service-Worker-Allowed'^'/'
'service-worker-allowed'^'/'
==
[[200 headers] `q.u.data]
==

View File

@ -5,7 +5,7 @@
/- glob
/+ default-agent, verb, dbug
|%
++ hash 0v1.4ujsp.698kt.ojftv.7jual.4hhu5
++ hash 0v3.g6u13.haedt.jt4hd.61ek5.6t30q
+$ 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
1 1
%.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-1 -]~
!> ^- update:store
[%0 now.bowl [%archive-graph resource]]
[now.bowl [%archive-graph resource]]
::
++ on-pull-kick
|= =resource

View File

@ -12,6 +12,7 @@
update:store
%graph-update
%graph-pull-hook
1 1
==
::
+$ agent (push-hook:push-hook config)
@ -23,20 +24,20 @@
state-zero
--
::
=| state-zero
=* state -
%- agent:dbug
%+ verb |
^- agent:gall
%- (agent:push-hook config)
^- agent
=<
=-
=| state-zero
=* state -
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
grp ~(. group bowl)
gra ~(. graph bowl)
hc ~(. +> bowl)
hc ~(. hook-core bowl)
::
++ on-init on-init:def
++ on-save !>(state)
@ -62,12 +63,12 @@
?> ?=(?(%add %remove) i.t.t.wire)
=* mark i.t.wire
:_ this
(build-permissions mark i.t.t.wire %next)^~
(build-permissions:hc mark i.t.t.wire %next)^~
::
[%transform-add @ ~]
=* mark i.t.wire
:_ this
(build-transform-add mark %next)^~
(build-transform-add:hc mark %next)^~
==
::
++ on-fail on-fail:def
@ -184,7 +185,7 @@
(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]]
::
++ take-update
|= =vase
@ -210,6 +211,7 @@
[%give %kick ~[resource+(en-path:res resource.q.update)] ~]~
==
--
^| ^= hook-core
|_ =bowl:gall
+* grp ~(. group bowl)
met ~(. mdl bowl)
@ -291,6 +293,9 @@
%- some
%+ levy ~(tap by nodes)
|= [=index:store =node:store]
=/ parent-index=index:store
(scag (dec (lent index)) index)
?: (~(has by nodes) parent-index) %.y
?. =(author.post.node src.bowl)
%.n
=/ =permissions:store
@ -303,8 +308,6 @@
%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)

View File

@ -10,18 +10,20 @@
$% state-0
state-1
state-2
state-3
==
::
+$ state-0 [%0 network:store]
+$ state-1 [%1 network:store]
+$ state-2 [%2 network:store]
+$ state-0 [%0 network:zero:store]
+$ state-1 [%1 network:zero:store]
+$ state-2 [%2 network:zero:store]
+$ state-3 [%3 network:store]
::
++ orm orm:store
++ orm-log orm-log:store
+$ debug-input [%validate-graph =resource:store]
--
::
=| state-2
=| state-3
=* state -
::
%- agent:dbug
@ -44,46 +46,49 @@
%0
%_ $
-.old %1
::
validators.old
(~(put in validators.old) %graph-validator-link)
::
cards
%+ weld cards
%+ turn
~(tap in (~(put in validators.old) %graph-validator-link))
|= validator=@t
^- card
=/ =wire /validator/[validator]
=/ =rave:clay [%sing %b [%da now.bowl] /[validator]]
[%pass wire %arvo %c %warp our.bowl [%home `rave]]
cards cards
validators.old validators.old
::
graphs.old
%- ~(run by graphs.old)
|= [=graph:store q=(unit mark)]
^- [graph:store (unit mark)]
:- (convert-unix-timestamped-graph graph)
|= [=graph:zero:store q=(unit mark)]
^- [graph:zero:store (unit mark)]
:- (convert-unix-timestamped-graph:zero-load graph)
?^ q q
`%graph-validator-link
::
update-logs.old
%- ~(run by update-logs.old)
|=(a=* *update-log:store)
|=(a=* *update-log:zero:store)
==
::
%1
%_ $
-.old %2
graphs.old (~(run by graphs.old) change-revision-graph)
graphs.old (~(run by graphs.old) change-revision-graph:zero-load)
::
update-logs.old
%- ~(run by update-logs.old)
|=(a=* *update-log:store)
|=(a=* *update-log:zero:store)
==
::
%2 [cards this(state old)]
%2
%_ $
-.old %3
update-logs.old (~(run by update-logs.old) update-log-to-one:store)
graphs.old (~(run by graphs.old) marked-graph-to-one:store)
archive.old (~(run by archive.old) marked-graph-to-one:store)
==
::
%3 [cards this(state old)]
==
::
++ zero-load
:: =* infinitely recurses
=, store=zero:store
=, orm=orm:zero:store
=, orm-log=orm-log:zero:store
|%
++ change-revision-graph
|= [=graph:store q=(unit mark)]
^- [graph:store (unit mark)]
@ -115,7 +120,7 @@
post.node(contents ~, hash ~)
%graph
%+ gas:orm *graph:store
:_ ~ :- %1
:_ ~ :- %0
:_ [%empty ~]
post.node(index (snoc index.post.node atom), hash ~)
::
@ -189,6 +194,7 @@
:- (maybe-unix-to-da atom)
(convert-unix-timestamped-node node)
--
--
::
++ on-watch
~/ %graph-store-watch
@ -205,9 +211,9 @@
[cards this]
::
++ give
|= =update-0:store
|= =action:store
^- (list card)
[%give %fact ~ [%graph-update !>([%0 now.bowl update-0])]]~
[%give %fact ~ [%graph-update-1 !>([now.bowl action])]]~
--
::
++ on-poke
@ -218,7 +224,7 @@
?> (team:title our.bowl src.bowl)
=^ cards state
?+ mark (on-poke:def mark vase)
%graph-update (graph-update !<(update:store vase))
%graph-update-1 (graph-update !<(update:store vase))
%noun (debug !<(debug-input vase))
%import (poke-import q.vase)
==
@ -228,7 +234,6 @@
|= =update:store
^- (quip card _state)
|^
?> ?=(%0 -.update)
=? p.update =(p.update *time) now.bowl
?- -.q.update
%add-graph (add-graph p.update +.q.update)
@ -259,28 +264,20 @@
?& !(~(has by archive) resource)
!(~(has by graphs) resource)
== ==
~| "validation of graph {<resource>} failed using mark {<mark>}"
?> (validate-graph graph mark)
=/ =logged-update:store
[%0 time %add-graph resource graph mark overwrite]
[time %add-graph resource graph mark overwrite]
=/ =update-log:store
(gas:orm-log ~ [time logged-update] ~)
:_ %_ state
graphs (~(put by graphs) resource [graph mark])
update-logs (~(put by update-logs) resource update-log)
archive (~(del by archive) resource)
::
validators
?~ mark validators
(~(put in validators) u.mark)
==
%- zing
:~ (give [/keys ~] %keys (~(put in ~(key by graphs)) resource))
(give [/updates ~] %add-graph resource *graph:store mark overwrite)
?~ mark ~
?: (~(has in validators) u.mark) ~
=/ wire /validator/[u.mark]
=/ =rave:clay [%sing %b [%da now.bowl] /[u.mark]]
[%pass wire %arvo %c %warp our.bowl [%home `rave]]~
==
::
++ remove-graph
@ -307,7 +304,7 @@
?< (check-for-duplicates graph ~(key by nodes))
=/ =update-log:store (~(got by update-logs) resource)
=. update-log
(put:orm-log update-log time [%0 time [%add-nodes resource nodes]])
(put:orm-log update-log time [time [%add-nodes resource nodes]])
::
:- (give [/updates]~ [%add-nodes resource nodes])
%_ state
@ -423,7 +420,7 @@
(~(got by graphs) resource)
=/ =update-log:store (~(got by update-logs) resource)
=. update-log
(put:orm-log update-log time [%0 time [%remove-nodes resource indices]])
(put:orm-log update-log time [time [%remove-nodes resource indices]])
=/ [affected-indices=(set index:store) new-graph=graph:store]
(remove-indices resource graph (sort ~(tap in indices) by-lent))
::
@ -510,7 +507,7 @@
(~(got by graphs) resource)
=/ =update-log:store (~(got by update-logs) resource)
=. update-log
(put:orm-log update-log time [%0 time [%add-signatures uid signatures]])
(put:orm-log update-log time [time [%add-signatures uid signatures]])
::
:- (give [/updates]~ [%add-signatures uid signatures])
%_ state
@ -555,7 +552,7 @@
=. update-log
%^ put:orm-log update-log
time
[%0 time [%remove-signatures uid signatures]]
[time [%remove-signatures uid signatures]]
::
:- (give [/updates]~ [%remove-signatures uid signatures])
%_ state
@ -658,9 +655,9 @@
$(cards (weld cards crds), updates t.updates)
::
++ give
|= [paths=(list path) update=update-0:store]
|= [paths=(list path) update=action:store]
^- (list card)
[%give %fact paths [%graph-update !>([%0 now.bowl update])]]~
[%give %fact paths [%graph-update-1 !>([now.bowl update])]]~
--
::
++ debug
@ -675,27 +672,27 @@
|= [=graph:store mark=(unit mark:store)]
^- ?
?~ mark %.y
?~ graph %.y
=/ =dais:clay
.^ =dais:clay
%cb
/(scot %p our.bowl)/[q.byk.bowl]/(scot %da now.bowl)/[u.mark]
==
|- ^- ?
?~ graph %.y
%+ roll (tap:orm graph)
|= [[=atom =node:store] out=?]
?& out
=(%& -:(mule |.((vale:dais [atom post.node]))))
^- ?
?& ?=(^ (vale:dais [atom post.node]))
?- -.children.node
%empty %.y
%graph ^$(graph p.children.node)
==
==
== ==
::
++ poke-import
|= arc=*
^- (quip card _state)
|^
=/ sty=state-2 [%2 (remake-network ;;(tree-network +.arc))]
=/ sty=state-3 [%3 (remake-network ;;(tree-network +.arc))]
:_ sty
%+ turn ~(tap by graphs.sty)
|= [rid=resource:store =marked-graph:store]
@ -724,8 +721,7 @@
+$ tree-update-logs (tree [resource:store tree-update-log])
+$ tree-update-log (tree [time tree-logged-update])
+$ tree-logged-update
$: %0
p=time
$: p=time
$= q
$% [%add-graph =resource:store =tree-graph mark=(unit ^mark) ow=?]
[%add-nodes =resource:store nodes=(tree [index:store tree-node])]
@ -806,7 +802,7 @@
++ remake-logged-update
|= t=tree-logged-update
^- logged-update:store
:+ %0 p.t
:- p.t
?- -.q.t
%add-graph
:* %add-graph
@ -862,16 +858,16 @@
``noun+!>(q.u.result)
::
[%x %keys ~]
:- ~ :- ~ :- %graph-update
!>(`update:store`[%0 now.bowl [%keys ~(key by graphs)]])
:- ~ :- ~ :- %graph-update-1
!>(`update:store`[now.bowl [%keys ~(key by graphs)]])
::
[%x %tags ~]
:- ~ :- ~ :- %graph-update
!>(`update:store`[%0 now.bowl [%tags ~(key by tag-queries)]])
:- ~ :- ~ :- %graph-update-1
!>(`update:store`[now.bowl [%tags ~(key by tag-queries)]])
::
[%x %tag-queries ~]
:- ~ :- ~ :- %graph-update
!>(`update:store`[%0 now.bowl [%tag-queries tag-queries]])
:- ~ :- ~ :- %graph-update-1
!>(`update:store`[now.bowl [%tag-queries tag-queries]])
::
[%x %graph @ @ ~]
=/ =ship (slav %p i.t.t.path)
@ -879,10 +875,9 @@
=/ result=(unit marked-graph:store)
(~(get by graphs) [ship term])
?~ result [~ ~]
:- ~ :- ~ :- %graph-update
:- ~ :- ~ :- %graph-update-1
!> ^- update:store
:+ %0
now.bowl
:- now.bowl
[%add-graph [ship term] `graph:store`p.u.result q.u.result %.y]
::
:: note: near-duplicate of /x/graph
@ -895,10 +890,9 @@
?~ result
~& no-archived-graph+[ship term]
[~ ~]
:- ~ :- ~ :- %graph-update
:- ~ :- ~ :- %graph-update-1
!> ^- update:store
:+ %0
now.bowl
:- now.bowl
[%add-graph [ship term] `graph:store`p.u.result q.u.result %.y]
::
[%x %export ~]
@ -912,9 +906,9 @@
=/ graph=(unit marked-graph:store)
(~(get by graphs) [ship term])
?~ graph [~ ~]
:- ~ :- ~ :- %graph-update
:- ~ :- ~ :- %graph-update-1
!> ^- update:store
:+ %0 now.bowl
:- now.bowl
:+ %add-nodes
[ship term]
%- ~(gas by *(map index:store node:store))
@ -939,10 +933,9 @@
(turn t.t.t.t.path (cury slav %ud))
=/ node=(unit node:store) (get-node ship term index)
?~ node [~ ~]
:- ~ :- ~ :- %graph-update
:- ~ :- ~ :- %graph-update-1
!> ^- update:store
:+ %0
now.bowl
:- now.bowl
:+ %add-nodes
[ship term]
(~(gas by *(map index:store node:store)) [index u.node] ~)
@ -959,10 +952,9 @@
=/ graph
(get-node-children ship term parent)
?~ graph [~ ~]
:- ~ :- ~ :- %graph-update
:- ~ :- ~ :- %graph-update-1
!> ^- update:store
:+ %0
now.bowl
:- now.bowl
:+ %add-nodes
[ship term]
%- ~(gas by *(map index:store node:store))
@ -990,10 +982,9 @@
=/ children
(get-node-children ship term index)
?~ children [~ ~]
:- ~ :- ~ :- %graph-update
:- ~ :- ~ :- %graph-update-1
!> ^- update:store
:+ %0
now.bowl
:- now.bowl
:+ %add-nodes
[ship term]
%- ~(gas by *(map index:store node:store))
@ -1017,10 +1008,9 @@
?- -.children.u.node
%empty [~ ~]
%graph
:- ~ :- ~ :- %graph-update
:- ~ :- ~ :- %graph-update-1
!> ^- update:store
:+ %0
now.bowl
:- now.bowl
:+ %add-nodes
[ship term]
%- ~(gas by *(map index:store node:store))
@ -1110,12 +1100,7 @@
::
:: old wire, do nothing
[%graph *] [~ this]
::
[%validator @ ~]
:_ this
=* validator i.t.wire
=/ =rave:clay [%next %b [%da now.bowl] /[validator]]
[%pass wire %arvo %c %warp our.bowl [%home `rave]]~
[%validator @ ~] [~ this]
::
[%try-rejoin @ *]
=/ rid=resource:store (de-path:res t.t.wire)

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,73 +37,7 @@
++ 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-poke on-poke:def
++ on-agent on-agent:def
++ on-watch on-watch:def
++ on-leave on-leave:def

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
@ -415,10 +415,7 @@
(~(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

@ -182,7 +182,7 @@
~[watch-graph:ha]
::
%fact
?. ?=(%graph-update p.cage.sign)
?. ?=(%graph-update-1 p.cage.sign)
(on-agent:def wire sign)
=^ cards state
(graph-update !<(update:graph-store q.cage.sign))
@ -277,7 +277,11 @@
=/ metadatum=(unit metadatum:metadata)
(peek-metadatum:met %graph rid)
?~ metadatum `state
abet:check:(abed:handle-update:ha rid nodes u.group module.u.metadatum)
=/ module=term
?: ?=(%empty -.config.u.metadatum) %$
?: ?=(%group -.config.u.metadatum) %$
module.config.u.metadatum
abet:check:(abed:handle-update:ha rid nodes u.group module)
--
::
++ on-peek on-peek:def
@ -455,7 +459,6 @@
=notif-kind:hook
==
^+ update-core
?: ?=(%none mode.notif-kind) update-core
=/ =stats-index:store
(to-stats-index:store index)
=. update-core

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: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)
@ -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.e821c1b85987caabfb1f.js"></script>
<script src="/~landscape/js/bundle/index.59e682153138f604d358.js"></script>
</body>
</html>

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)
@ -64,16 +65,25 @@
~
=/ 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,6 +86,11 @@
==
::
+$ base-state-2
$: associations=associations-2
~
==
::
+$ base-state-3
$: =associations:store
~
==
@ -83,6 +103,9 @@
+$ 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)
::
%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-1
^- 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-1
^- update
:+ %0 now
:- now
:+ %add-nodes [our name]
%- ~(gas by *(map index node))
~[[[now]~ [post [%empty ~]]]]

View File

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

View File

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

View File

@ -5,6 +5,6 @@
|= $: [now=@da eny=@uvJ =beak]
[[=resource ~] ~]
==
:- %graph-update
:- %graph-update-1
^- 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-1
=/ 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-1
=- ~& update=- -
.^(=update:graph-store %cx path)

View File

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

View File

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

View File

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

View File

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

View File

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

@ -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-1]
?> ?=(%keys -.q.upd)
resources.q.upd
:: count activity per channel

View File

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

View File

@ -5,6 +5,101 @@
=, sur
=, pos
|%
::
++ update-log-to-one
|= =update-log:zero
^- ^update-log
%+ gas:orm-log *^update-log
%+ turn (tap:orm-log:zero update-log)
|= [=time =logged-update:zero]
:- time
:- p.logged-update
(logged-update-to-one q.logged-update)
::
++ logged-update-to-one
|= upd=logged-update-0:zero
?+ -.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)]
--
:: NOTE: move these functions to zuse
++ nu :: parse number as hex
|= jon=json
@ -78,7 +173,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 +190,28 @@
==
==
::
++ 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)
--
::
++ post
|= p=^post
^- json
@ -110,11 +227,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
@ -247,9 +363,8 @@
++ update
|= jon=json
^- ^update
:- %0
:- *time
^- update-0
^- action
=< (decode jon)
|%
++ decode
@ -333,10 +448,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

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

@ -32,6 +32,47 @@
%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
@ -43,7 +84,6 @@
^- graph:store
=/ =update:store
(get-graph res)
?> ?=(%0 -.update)
?> ?=(%add-graph -.q.update)
graph.q.update
::
@ -54,7 +94,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 +104,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 +137,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

@ -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,16 +76,35 @@
failed-kicks=(map resource ship)
==
::
+$ track
[=ship =status]
::
+$ status
$% [%active ~]
[%failed-kick ~]
[%pub-ver ver=@ud]
[%sub-ver ver=@ud]
==
::
+$ base-state-2
$: tracking=(map resource track)
inner-state=vase
==
::
+$ state-0 [%0 base-state-0]
::
+$ state-1 [%1 base-state-0]
::
+$ state-2 [%2 base-state-1]
::
+$ state-3 [%3 base-state-2]
::
+$ versioned-state
$% state-0
state-1
state-2
state-3
==
::
++ default
@ -176,7 +198,7 @@
++ agent
|* =config
|= =(pull-hook config)
=| state-2
=| state-3
=* state -
^- agent:gall
=<
@ -185,6 +207,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,55 +224,33 @@
=| cards=(list card:agent:gall)
|^
?- -.old
%2
%3
=^ og-cards pull-hook
(on-load:og inner-state.old)
=. state old
=^ retry-cards state
retry-failed-kicks
:_ this
:(weld cards og-cards retry-cards)
:(weld cards og-cards (poke-self:pass kick+!>(%kick))^~)
::
%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
@ -263,6 +266,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 +282,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,34 +306,22 @@
=^ 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)
=/ 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]
::
%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]
@ -336,12 +335,14 @@
=^ 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))
@ -353,14 +354,283 @@
--
|_ =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)))
=/ 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)
=/ =vase
(convert-to:ver cage)
=/ =wire
(make-wire /store)
=+ resources=(~(gas in *(set resource)) (resource-for-update:og vase))
?> ?| no-validate.config
?& (check-src resources)
(~(has in resources) rid)
== ==
=/ =mark
(append-version:ver version.config)
(tr-emit (~(poke-our pass wire) store-name.config mark vase))
--
::
++ tr-kick
?. ?=(%active -.status) tr-core
=/ pax
(kick-mule:virt rid |.((on-pull-kick:og rid)))
?~ pax tr-failed-kick
?~ u.pax tr-cleanup
(tr-watch u.u.pax)
:: +| %lifecycle: lifecycle management for tracked resource
::
::
++ tr-add
|= [s=^ship r=resource]
=: ship s
rid r
status [%active ~]
==
(tr-watch /)
::
++ tr-remove
tr-leave:tr-cleanup
::
++ tr-hook-act
|= =action
^+ tr-core
?- -.action
%add (tr-add +.action)
%remove tr-remove:(tr-abed resource.action)
==
::
++ tr-cleanup
=. gone %.y
(tr-emit give-update)
::
++ tr-failed-kick
tr-core(status [%failed-kick ~])
::
++ tr-suspend-pub-ver
|= ver=@ud
=. status [%pub-ver ver]
tr-leave:tr-watch-ver
::
::
++ tr-suspend-sub-ver
|= ver=@ud
tr-core(status [%sub-ver ver])
::
++ tr-on-load
?+ -.status tr-core
%failed-kick tr-restart
%active tr-rewatch
::
%sub-ver
?. (supported:ver (append-version:ver ver.status))
tr-core
tr-restart
==
::
++ tr-restart
=. status [%active ~]
tr-kick
::
++ tr-rewatch
tr-kick:tr-leave
::
::
:: +| %subscription: subscription cards
::
::
++ tr-ver-wire
(make-wire /version)
::
++ tr-watch-ver
(tr-emit (watch-version ship))
::
++ tr-leave-ver
(tr-emit (~(leave pass tr-ver-wire) tr-sub-dock))
++ tr-sub-wire
(make-wire pull+resource+(en-path:resource rid))
++ tr-unver-sub-wire
(make-wire pull+unver-resource+(en-path:resource rid))
::
++ tr-sub-dock
^- dock
[ship push-hook-name.config]
::
++ tr-check-sub
?: (~(has by wex.bowl) [tr-sub-wire tr-sub-dock])
tr-core
tr-kick
::
++ tr-watch-unver
|= pax=path
=/ =path
:- %resource
(weld (en-path:resource rid) pax)
(tr-emit (~(watch pass tr-unver-sub-wire) tr-sub-dock path))
::
++ tr-watch
|= pax=path
^+ tr-core
=/ =path
:+ %resource %ver
%+ weld
(snoc (en-path:resource rid) (scot %ud version.config))
pax
(tr-emit (~(watch pass tr-sub-wire) tr-sub-dock path))
::
++ tr-leave
(tr-emit (~(leave pass tr-sub-wire) tr-sub-dock))
--
::
++ take-version
|= [who=ship =sign:agent:gall]
^- [[(list card) _pull-hook] _state]
?+ -.sign !!
%watch-ack
?~ p.sign [~^pull-hook state]
=/ =tank leaf+"subscribe failed from {<dap.bowl>} on wire {<wire>}"
%- (slog tank u.p.sign)
[~^pull-hook state]
::
%kick
:_ state
[(watch-version who)^~ pull-hook]
::
%fact
?. =(%version p.cage.sign)
[~^pull-hook state]
=+ !<(version=@ud q.cage.sign)
=/ tracks=(list [rid=resource =track])
~(tap by tracking)
=| cards=(list card)
=| leave=_&
|-
?~ tracks
=? cards leave
:_(cards (leave-version who))
[[cards pull-hook] state]
?. ?=(%pub-ver -.status.track.i.tracks)
$(tracks t.tracks)
?. =(who ship.track.i.tracks)
$(tracks t.tracks)
?. =(ver.status.track.i.tracks version)
=. leave %.n
$(tracks t.tracks)
=^ [caz=(list card) hook=_pull-hook] state
tr-abet:tr-restart:(tr-abed:track-engine rid.i.tracks)
=. pull-hook hook
$(tracks t.tracks, cards (weld cards caz))
==
::
++ version-wir
(make-wire /version)
::
++ watch-version
|= =ship
(~(watch pass version-wir) [ship push-hook-name.config] /version)
::
++ leave-version
|= =ship
(~(leave pass version-wir) [ship push-hook-name.config])
::
++ poke-sane
^- (quip card:agent:gall _state)
=/ cards
restart-subscriptions
:: TODO revive
~ :: restart-subscriptions
~? > ?=(^ cards)
"Fixed subscriptions in {<dap.bowl>}"
:_ state
restart-subscriptions
[cards state]
::
++ check-subscription
|= [rid=resource =ship]
@ -375,122 +645,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 +663,8 @@
%+ roll ~(tap in resources)
|= [rid=resource out=_|]
?: out %.y
?~ ship=(~(get by tracking) rid)
?~ status=(~(get by tracking) rid)
%.n
=(src.bowl u.ship)
::
++ update-store
|= [wire-rid=resource =vase]
^- card
=/ =wire
(make-wire /store)
=+ resources=(~(gas in *(set resource)) (resource-for-update:og vase))
?> ?| no-validate.config
?& (check-src resources)
(~(has in resources) wire-rid)
== ==
[%pass wire %agent [our.bowl store-name.config] %poke update-mark.config vase]
=(src.bowl ship.u.status)
--
--

View File

@ -25,7 +25,7 @@
:: foreign push-hook
::
/- *push-hook
/+ default-agent, resource, verb
/+ default-agent, resource, verb, versioning, agentio
|%
+$ card card:agent:gall
::
@ -43,6 +43,8 @@
update=mold
update-mark=term
pull-hook-name=term
version=@ud
min-version=@ud
==
::
:: $base-state-0: state for the push hook
@ -160,6 +162,9 @@
og ~(. push-hook bowl)
hc ~(. +> bowl)
def ~(. (default-agent this %|) bowl)
io ~(. agentio bowl)
pass pass:io
ver ~(. versioning [bowl [update-mark version min-version]:config])
::
++ on-init
=^ cards push-hook
@ -177,7 +182,14 @@
%1
=^ og-cards push-hook
(on-load:og inner-state.old)
[(weld cards og-cards) this(state old)]
=/ old-subs
find-old-subs
=/ version-cards
:- (fact:io version+!>(version.config) /version ~)
?~ old-subs ~
(kick:io old-subs)^~
[:(weld cards og-cards version-cards) this(state old)]
::
::
%0
%_ $
@ -192,6 +204,19 @@
==
==
::
++ find-old-subs
%~ tap in
%+ roll
~(val by sup.bowl)
|= [[=ship =path] out=(set path)]
?. ?=([%resource *] path) out
?. ?=([%resource %ver] path)
(~(put in out) path)
=/ path-ver=@ud
(ver-from-path:hc path)
?: (supported:ver (append-version:ver path-ver)) out
(~(put in out) path)
::
++ kicked-watches
^- (list path)
%~ tap in
@ -218,14 +243,9 @@
(poke-hook-action:hc !<(action vase))
[cards this]
::
?: =(mark update-mark.config)
?: (team:title [our src]:bowl)
?: (is-root:ver mark)
:_ this
(forward-update:hc vase)
=^ cards state
(poke-update:hc vase)
[cards this]
::
(forward-update:hc mark vase)
=^ cards push-hook
(on-poke:og mark vase)
[cards this]
@ -233,17 +253,41 @@
++ 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]
|^
?. ?=([%ver %ship @ @ @ *] t.path)
unversioned
=/ =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))
=/ =vase
(convert-to:ver mark (initial-watch:og t.t.t.t.t.t.path resource))
:_ this
[%give %fact ~ mark vase]~
::
++ unversioned
?> ?=([%ship @ @ *] t.path)
?. =(min-version.config 0)
~& >>> "unversioned req from: {<src.bowl>}, nooping"
`this
=/ =resource
(de-path:resource t.path)
=/ =vase
%+ convert-to:ver update-mark.config
(initial-watch:og t.t.t.t.path resource)
:_ this
[%give %fact ~ update-mark.config vase]~
--
::
++ on-agent
|= [=wire =sign:agent:gall]
@ -258,7 +302,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 +310,7 @@
(take-update:og q.cage.sign)
:_ this
%+ weld
(push-updates:hc q.cage.sign)
(push-updates:hc cage.sign)
cards
==
::
@ -293,21 +337,17 @@
^- (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)
==
--
|_ =bowl:gall
+* og ~(. push-hook bowl)
::
++ poke-update
|= vas=vase
^- (quip card:agent:gall _state)
=/ vax=(unit vase) (transform-proxy-update:og vas)
?> ?=(^ vax)
=/ wire (make-wire /store)
:_ state
[%pass wire %agent [our.bowl store-name.config] %poke update-mark.config u.vax]~
ver ~(. versioning [bowl [update-mark version min-version]:config])
io ~(. agentio bowl)
pass pass:io
::
++ poke-hook-action
|= =action
@ -378,46 +418,94 @@
[%pass wire %agent [our.bowl store-name.config] %watch store-path.config]
::
++ push-updates
|= =vase
|= =cage
^- (list card:agent:gall)
%+ roll (resource-for-update q.cage)
|= [rid=resource cards=(list card)]
|^
:(weld cards versioned unversioned)
::
++ versioned
^- (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
resource+ver+(en-path:resource rid)
=/ paths=(jug @ud path)
%+ roll
(incoming-subscriptions prefix)
|=([ship pax=path] pax)
?~ paths $(rids t.rids)
%_ $
rids t.rids
cards (snoc cards [%give %fact paths update-mark.config vase])
==
|= [[ship =path] out=(jug @ud path)]
=/ path-ver=@ud
(ver-from-path path)
(~(put ju out) path-ver path)
%+ turn ~(tap by paths)
|= [fact-ver=@ud paths=(set path)]
=/ =mark
(append-version:ver fact-ver)
=/ =^cage
:- mark
(convert-from:ver mark q.cage)
(fact:io cage ~(tap in paths))
:: TODO: deprecate
++ unversioned
?. =(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)) ~
=/ =^cage
:- update-mark.config
(convert-from:ver update-mark.config q.cage)
(fact:io cage ~(tap in unversioned))^~
--
::
++ forward-update
|= =vase
|= =cage
^- (list card:agent:gall)
=/ rids=(list resource) (resource-for-update vase)
=| cards=(list card:agent:gall)
|-
?~ rids cards
=- lis
=/ vas
(convert-to:ver cage)
%+ roll (resource-for-update q.cage)
|= [rid=resource [lis=(list card:agent:gall) tf-vas=(unit vase)]]
^- [(list card:agent:gall) (unit vase)]
=/ =path
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)
=/ =wire (make-wire path)
=* ship entity.rid
=. tf-vas
?. =(our.bowl ship)
:: do not transform before forwarding
::
cards
%+ snoc cards
[%pass wire %agent [entity.i.rids dap] %poke update-mark.config vase]
==
`vas
:: use cached transform
::
?^ tf-vas tf-vas
:: transform before poking store
::
(transform-proxy-update:og vas)
~| "forwarding failed during transform. mark: {<p.cage>} resource: {<rid>}"
?> ?=(^ tf-vas)
=/ =dock
:- ship
?. =(our.bowl ship)
:: forward to host
::
dap.bowl
:: poke our store
::
store-name.config
=/ cag=^cage
:- current-version:ver
u.tf-vas
:_ tf-vas
[[%pass wire %agent dock %poke cag] lis]
::
++ ver-from-path
|= =path
=/ extra=^path
(slag 5 path)
?> ?=(^ extra)
(slav %ud i.extra)
::
++ resource-for-update
|= =vase

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -0,0 +1,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,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)

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

View File

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

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

@ -0,0 +1,12 @@
|_ ver=@ud
++ grad %noun
++ grow
|%
++ noun ver
++ json (numb:enjs:format ver)
--
++ grab
|%
++ noun @ud
--
--

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

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

View File

@ -12,6 +12,76 @@
:: %yes: May add a node or remove node
+$ permission-level
?(%no %self %yes)
::
++ zero
=< [. post-zero]
=, post-zero
|%
::
++ orm ((ordered-map atom node) gth)
++ orm-log ((ordered-map time logged-update) gth)
::
+$ graph ((mop atom node) gth)
+$ marked-graph [p=graph q=(unit mark)]
::
+$ node [=post children=internal-graph]
+$ graphs (map resource marked-graph)
::
+$ tag-queries (jug term resource)
::
+$ update-log ((mop time logged-update) gth)
+$ update-logs (map resource update-log)
::
::
+$ internal-graph
$~ [%empty ~]
$% [%graph p=graph]
[%empty ~]
==
::
+$ network
$: =graphs
=tag-queries
=update-logs
archive=graphs
validators=(set mark)
==
::
+$ update
$% [%0 p=time q=update-0]
==
::
+$ logged-update
$% [%0 p=time q=logged-update-0]
==
::
+$ logged-update-0
$% [%add-graph =resource =graph mark=(unit mark) overwrite=?]
[%add-nodes =resource nodes=(map index node)]
[%remove-nodes =resource indices=(set index)]
[%add-signatures =uid =signatures]
[%remove-signatures =uid =signatures]
==
::
+$ update-0
$% logged-update-0
[%remove-graph =resource]
::
[%add-tag =term =resource]
[%remove-tag =term =resource]
::
[%archive-graph =resource]
[%unarchive-graph =resource]
[%run-updates =resource =update-log]
::
:: NOTE: cannot be sent as pokes
::
[%keys =resources]
[%tags tags=(set term)]
[%tag-queries =tag-queries]
==
--
+$ graph ((mop atom node) gth)
+$ marked-graph [p=graph q=(unit mark)]
::
@ -38,15 +108,12 @@
validators=(set mark)
==
::
+$ update
$% [%0 p=time q=update-0]
==
+$ update [p=time q=action]
::
+$ logged-update
$% [%0 p=time q=logged-update-0]
==
+$ logged-update [p=time q=logged-action]
::
+$ logged-update-0
+$ logged-action
$% [%add-graph =resource =graph mark=(unit mark) overwrite=?]
[%add-nodes =resource nodes=(map index node)]
[%remove-nodes =resource indices=(set index)]
@ -54,8 +121,8 @@
[%remove-signatures =uid =signatures]
==
::
+$ update-0
$% logged-update-0
+$ action
$% logged-action
[%remove-graph =resource]
::
[%add-tag =term =resource]

View File

@ -1,4 +1,4 @@
/- *group, store=graph-store
/- *group, store=graph-store, met=metadata-store
/+ resource
^?
|%
@ -43,6 +43,8 @@
[%forward rid=resource =update:store]
[%eval =cord]
[%pending-indices pending=(map hash:store index:store)]
[%create-group-feed group=resource vip=vip-metadata:met]
[%disable-group-feed group=resource]
==
--

View File

@ -2,6 +2,13 @@
^?
|%
::
+$ request
$: hidden=?
started=time
=ship
=progress
==
::
+$ action
$% :: host side
[%create name=term =policy title=@t description=@t]
@ -11,6 +18,8 @@
[%leave =resource]
::
[%invite =resource ships=(set ship) description=@t]
:: pending ops
[%hide =resource]
==
::
@ -21,7 +30,9 @@
?(%no-perms %strange %done)
::
+$ update
$% [%initial initial=(map resource progress)]
$% [%initial initial=(map resource request)]
[%started =resource =request]
[%progress =resource =progress]
[%hide =resource]
==
--

View File

@ -33,7 +33,7 @@
==
::
+$ contents
$% [%graph =(list post:post)]
$% [%graph =(list post:post-zero:post)]
[%group =(list group-contents)]
[%chat =(list envelope:chat-store)]
==
@ -75,7 +75,7 @@
[date=@da read=? =contents]
::
+$ contents
$% [%graph =(list post:post)]
$% [%graph =(list post:post-zero:post)]
[%group =(list group-contents)]
==
::
@ -90,6 +90,38 @@
::
--
::
++ state-three
=< state
|%
+$ state
$: unreads-each=(jug stats-index index:graph-store)
unreads-count=(map stats-index @ud)
last-seen=(map stats-index @da)
=notifications
archive=notifications
current-timebox=@da
dnd=_|
==
::
++ orm
((ordered-map @da timebox) gth)
::
+$ notification
[date=@da read=? =contents]
::
+$ contents
$% [%graph =(list post:post-zero:post)]
[%group =(list group-contents)]
==
::
+$ timebox
(map index notification)
::
+$ notifications
((mop @da timebox) gth)
::
--
::
+$ index
$% $: %graph
group=resource

View File

@ -25,18 +25,35 @@
:: %reader-comments: Allow readers to comment, regardless
:: of whether they can write. (notebook, collections)
:: %member-metadata: Allow members to add channels (groups)
:: %host-feed: Only host can post to group feed
:: %admin-feed: Only admins and host can post to group feed
:: %$: No variation
::
+$ vip-metadata ?(%reader-comments %member-metadata %$)
+$ vip-metadata
$? %reader-comments
%member-metadata
%host-feed
%admin-feed
%$
==
::
+$ md-config
$~ [%empty ~]
$% [%group feed=(unit (unit md-resource))]
[%graph module=term]
[%empty ~]
==
::
+$ metadatum
$: title=cord
description=cord
=color
date-created=time
creator=ship
module=term
config=md-config
picture=url
preview=?
hidden=?
vip=vip-metadata
==
::
@ -61,4 +78,38 @@
=metadatum
==
==
:: historical
++ zero
|%
::
+$ association [group=resource =metadatum]
::
+$ associations (map md-resource association)
::
+$ metadatum
$: title=cord
description=cord
=color
date-created=time
creator=ship
module=term
picture=url
preview=?
vip=vip-metadata
==
::
+$ update
$% [%add group=resource resource=md-resource =metadatum]
[%remove group=resource resource=md-resource]
[%initial-group group=resource =associations]
[%associations =associations]
$: %updated-metadata
group=resource
resource=md-resource
before=metadatum
=metadatum
==
==
::
--
--

View File

@ -1,7 +1,14 @@
|%
+$ observer [app=term =path thread=term]
+$ action
$% [%watch =observer]
$% :: %gall actions
::
[%watch =observer]
[%ignore =observer]
::
:: %clay actions
::
[%warm-cache-all ~]
[%cool-cache-all ~]
==
--

View File

@ -1,5 +1,27 @@
/- *resource
|%
::
++ post-zero
|%
::
+$ content
$% [%text text=cord]
[%mention =ship]
[%url url=cord]
[%code expression=cord output=(list tank)]
[%reference =uid]
==
::
+$ post
$: author=ship
=index
time-sent=time
contents=(list content)
hash=(unit hash)
=signatures
==
--
+$ index (list atom)
+$ uid [=resource =index]
::
@ -26,13 +48,16 @@
contents=(list content)
==
::
+$ reference
$% [%graph group=resource =uid]
[%group group=resource]
==
::
+$ content
$% [%text text=cord]
[%mention =ship]
[%url url=cord]
[%code expression=cord output=(list tank)]
[%reference =uid]
:: TODO: maybe use a cask?
::[%cage =cage]
[%reference =reference]
==
--

View File

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

View File

@ -249,6 +249,7 @@
font-family: "Source Code Pro";
src: url("https://storage.googleapis.com/media.urbit.org/fonts/scp-regular.woff");
font-weight: 400;
font-display: swap;
}
:root {
--red05: rgba(255,65,54,0.05);

View File

@ -1,30 +1,299 @@
/- spider
/+ strandio
=, strand=strand:spider
=, clay
^- thread:spider
|= arg=vase
=/ m (strand ,vase)
^- form:m
|^
=+ !<([~ =a=path =b=path] arg)
=/ a-mark=mark -:(flop a-path)
=/ b-mark=mark -:(flop b-path)
?. =(a-mark b-mark)
(strand-fail:strandio %files-not-same-type ~)
:: workaround to make the shallow flag optional. if it's specified we
:: do require a non-empty path - however this shouldn't be called with
:: empty paths to begin with.
=+ !<([~ =a=path b=$~([/hi &] $^([(lest @ta) flag] path))] arg)
=/ [b-path=path shallow=flag] ?:(?=([^ *] b) b [`path`b |])
=/ a-beam (need (de-beam a-path))
;< =a=cage bind:m (get-file a-path)
;< =b=cage bind:m (get-file b-path)
;< =dais:clay bind:m (build-mark:strandio -.a-beam a-mark)
(pure:m (~(diff dais q.a-cage) q.b-cage))
=/ b-beam (need (de-beam b-path))
;< a-dome=dome bind:m (get-from-clay a-beam dome %v)
;< b-dome=dome bind:m (get-from-clay b-beam dome %v)
;< diffs=(list diff-type) bind:m (diff-beams a-beam b-beam)
%- pure:m
!> ^- tang
:: our tang is built in reverse order
%- flop
?: shallow
(format-shallow diffs a-beam b-beam)
(format-deep diffs a-beam b-beam)
::
:: $diff-type: type for diffs produced.
:: 1. %txt-diff is a standard diff (i.e. for hoon and txt files)
:: 2. %directory-diff shows unique files between two directories
:: 3. %other is for files that don't use txt-diff - we just take
:: the mug of the files
+$ diff-type
:: paths of the diffed beams
$: a=path
b=path
$% [%txt-diff diff=(urge cord)]
[%directory-diff p=(list path) q=(list path)]
[%other p=@ q=@]
==
==
:: +diff-is-empty: check if a diff is empty (for two identical files)
::
++ diff-is-empty
|= d=diff-type
^- flag
?: ?=([%txt-diff *] +.+.d)
:: levy produces & on empty lists
%+ levy
diff.d
|= u=(unce cord)
^- flag
-:u
?: ?=([%directory-diff *] +.+.d)
=(p.d q.d)
=(p.d q.d)
:: +get-file: retrieve a cage of a file from clay
::
++ get-file
|= =path
|= =beam
=/ m (strand ,cage)
^- form:m
=/ beam (need (de-beam path))
;< =riot:clay bind:m
(warp:strandio p.beam q.beam ~ %sing %x r.beam s.beam)
?~ riot
(strand-fail:strandio %file-not-found >path< ~)
(strand-fail:strandio %file-not-found >s.beam< ~)
(pure:m r.u.riot)
:: +get-from-clay: retrieve other data from clay based on care
::
++ get-from-clay
|* [=beam mol=mold =care]
=/ m (strand ,mol)
^- form:m
;< =riot:clay bind:m
(warp:strandio p.beam q.beam ~ %sing care r.beam s.beam)
?~ riot
(strand-fail:strandio %file-not-found >s.beam< ~)
(pure:m !<(mol q.r.u.riot))
:: +diff-beams: recursively diff two beams. produces a vase
:: of (list diff-type)
::
++ diff-beams
=<
|= [a=beam b=beam]
=/ m (strand ,(list diff-type))
^- form:m
;< hash-a=@ bind:m (get-from-clay a @ %z)
;< hash-b=@ bind:m (get-from-clay b @ %z)
:: if the recursive hashes for each beam are the same we bail early
?: =(hash-a hash-b)
(pure:m *(list diff-type))
;< a-arch=arch bind:m (get-from-clay a arch %y)
;< b-arch=arch bind:m (get-from-clay b arch %y)
;< file-diff=(unit diff-type) bind:m (diff-file-contents a a-arch b b-arch)
:: get distinct files along with shared files
=/ a-keys=(set @t) ~(key by dir.a-arch)
=/ b-keys=(set @t) ~(key by dir.b-arch)
:: unique children
=/ a-unique-children=(set @t) (~(dif in a-keys) b-keys)
=/ b-unique-children=(set @t) (~(dif in b-keys) a-keys)
;< a-unique=(list path) bind:m (format-unique-children a a-arch a-unique-children)
;< b-unique=(list path) bind:m (format-unique-children b b-arch b-unique-children)
=/ unique-diff=diff-type [s.a s.b %directory-diff a-unique b-unique]
:: shared children
=/ find-common-diffs
|.
^- form:m
=| acc=(list diff-type)
=/ common-children=(list @t) ~(tap in (~(int in a-keys) b-keys))
|-
=* loop $
^- form:m
?~ common-children
(pure:m acc)
=/ child=@t i.common-children
=/ new-a=beam a(s (snoc s.a child))
=/ new-b=beam b(s (snoc s.b child))
;< diffs=(list diff-type) bind:m
(diff-beams new-a new-b)
:: ;< introduces another $ so we use "loop" instead.
%= loop
acc (weld diffs acc)
common-children t.common-children
==
;< common-diffs=(list diff-type) bind:m (find-common-diffs)
%- pure:m
^- (list diff-type)
%+ skip
;: weld
(drop file-diff)
[unique-diff ~]
common-diffs
==
diff-is-empty
|%
:: +format-unique-children: produce list of paths representing
:: files that are unique within a directory.
::
++ format-unique-children
|= [bem=beam ark=arch children=(set @t)]
=/ m (strand ,(list path))
^- form:m
=/ children=(list @t) ~(tap in children)
=| acc=(list path)
|-
=* loop $
^- form:m
?~ children
(pure:m acc)
:: the %t care gives all paths with the specified prefix
;< res=(list path) bind:m (get-from-clay bem(s (snoc s.bem i.children)) (list path) %t)
%= loop
acc (weld res acc)
children t.children
==
:: +diff-file-contents: diff two files at specified beams,
:: producing a vase of (unit diff-type)
++ diff-file-contents
=<
|= [a=beam a-arch=arch b=beam b-arch=arch]
=/ m (strand ,(unit diff-type))
^- form:m
?: =(fil.a-arch fil.b-arch)
(pure:m *(unit diff-type))
?~ fil.a-arch
:: only b has contents
%- pure:m
^- (unit diff-type)
%- some
:^ s.a
s.b
%txt-diff
:_ ~
^- (unce cord)
:+ %|
~
~[(format-file-content-missing s.b q.b)]
?~ fil.b-arch
:: only a has contents
%- pure:m
^- (unit diff-type)
%- some
:^ s.a
s.b
%txt-diff
:_ ~
^- (unce cord)
:+ %|
~[(format-file-content-missing s.a q.a)]
~
:: have two file contents - check that they have
:: the same mark.
=/ mar=mark -:(flop s.a)
?: !=(mar -:(flop s.b))
(strand-fail:strandio %files-not-same-type >s.a< >s.b< ~)
;< =a=cage bind:m (get-file a)
;< =b=cage bind:m (get-file b)
;< =dais:clay bind:m (build-mark:strandio -.a mar)
:: for txt-diff we produce an actual diff with type (urge cord).
:: for all other marks we just take the mug)
%- pure:m
?: =(form:dais %txt-diff)
^- (unit diff-type)
%- some
:^ s.a
s.b
%txt-diff
!<((urge cord) (~(diff dais q.a-cage) q.b-cage))
^- (unit diff-type)
%- some
:^ s.a
s.b
%other
:: For some reason, vases for identical files on different desks
:: can sometimes have different types. for this reason, we only
:: take the mug of the data.
[(mug q.q.a-cage) (mug q.q.b-cage)]
|%
++ format-file-content-missing
|= [p=path d=desk]
^- cord
%- crip
;: weld
"only "
<p>
" in desk "
<d>
" has file contents"
==
--
--
:: +format-beams: helper to combine two beams into a tank
::
++ format-beams
|= [a=beam b=beam]
^- tank
[%rose [" " ~ ~] ~[(smyt (en-beam a)) (smyt (en-beam b))]]
:: +format-directory-diff: helper for producing a tank based on
:: a %directory-diff
::
++ format-directory-diff
|= [paths=(list path) =beam]
^- tang
=/ prefix=tape (weld "only in " <(en-beam beam)>)
%+ turn
paths
|= p=path
^- tank
[%rose [": " ~ ~] [leaf+prefix (smyt p) ~]]
:: +format-shallow: converts a list of diff-type generated
:: between desks a and b into a tang in a shallow manner (just
:: listing files that differ).
::
++ format-shallow
|= [diffs=(list diff-type) a=beam b=beam]
^- tang
%+ reel
diffs
|= [d=diff-type acc=tang]
^- tang
?: ?=([%txt-diff *] +.+.d)
[(format-beams a(s a.d) b(s b.d)) acc]
?: ?=([%other *] +.+.d)
[(format-beams a(s a.d) b(s b.d)) acc]
?: ?=([%directory-diff *] +.+.d)
;: weld
(format-directory-diff p.d a)
(format-directory-diff q.d b)
acc
==
!!
:: +format-deep: converts a list of diff-type generated
:: between desks a and b into a tang in a deep manner (preserving
:: diff information for files)
++ format-deep
|= [diffs=(list diff-type) a=beam b=beam]
^- tang
%+ reel
diffs
|= [d=diff-type acc=tang]
^- tang
?: ?=([%txt-diff *] +.+.d)
:+ (format-beams a(s a.d) b(s b.d))
>diff.d<
acc
?: ?=([%directory-diff *] +.+.d)
;: weld
(format-directory-diff p.d a)
(format-directory-diff q.d b)
acc
==
?: ?=([%other *] +.+.d)
=/ a-tank=tank (smyt (en-beam a(s a.d)))
=/ b-tank=tank (smyt (en-beam b(s b.d)))
:+ [%rose [" " "files " ~] ~[a-tank b-tank]]
[%rose [" and " "have mugs: " ~] ~[leaf+<p.d> leaf+<q.d>]]
acc
!!
--

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