urbit/shrub
1
1
Fork 0
mirror of https://github.com/urbit/shrub.git synced 2024-12-25 21:12:56 +03:00
Code Issues Packages Projects Releases Wiki Activity

Merge tag 'urbit-v1.3' into mingw-port

Browse Source
This commit is contained in:
~locpyl-tidnyd 2021-04-02 22:06:29 +00:00
commit 4882b0040b
589 changed files with 25230 additions and 27437 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.github/actions/glob/Dockerfile vendored
View File

@ -1,4 +1,4 @@
FROM jaredtobin/janeway:v0.13.3
FROM jaredtobin/janeway:v0.13.4
COPY entrypoint.sh /entrypoint.sh
EXPOSE 22/tcp
ENTRYPOINT ["/entrypoint.sh"]

24
.github/workflows/build.yml vendored
View File

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

27
.github/workflows/merge-master.yml vendored Normal file
View File

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

10
.github/workflows/merge.yml → .github/workflows/merge-release.yml vendored
View File

@ -1,17 +1,17 @@
name: merge
name: ops-merge
on:
push:
branches:
- 'master'
- 'release/*'
jobs:
merge-to-next-js:
merge-release-to-ops:
runs-on: ubuntu-latest
name: "Merge master to release/next-js"
name: "Merge to ops-tlon"
steps:
- uses: actions/checkout@v2
- uses: devmasx/merge-branch@v1.3.1
with:
type: now
target_branch: release/next-js
target_branch: ops-tlon
github_token: ${{ secrets.JANEWAY_BOT_TOKEN }}

20
.github/workflows/ops-group-timer.yml vendored Normal file
View File

@ -0,0 +1,20 @@
name: group-timer
on:
push:
branches:
- 'ops/group-timer'
jobs:
glob:
runs-on: ubuntu-latest
name: "Create and deploy a glob to ~difmex-passed"
steps:
- uses: actions/checkout@v2
with:
lfs: true
- uses: ./.github/actions/glob
with:
ship: 'difmex-passed'
credentials: ${{ secrets.JANEWAY_SERVICE_KEY }}
ssh-sec-key: ${{ secrets.JANEWAY_SSH_SEC_KEY }}
ssh-pub-key: ${{ secrets.JANEWAY_SSH_PUB_KEY }}

62
.github/workflows/publish-npm-packages.yml vendored Normal file
View File

@ -0,0 +1,62 @@
name: publish-npm-packages
on:
push:
branches:
- 'master'
paths:
- 'pkg/npm/**'
jobs:
publish-api:
runs-on: ubuntu-latest
name: "Publish '@urbit/api' if a new version is available"
steps:
- uses: actions/checkout@v2
with:
lfs: true
- uses: actions/setup-node@v2
with:
node-version: '14'
- run: 'npm install'
working-directory: 'pkg/npm/api'
- uses: JS-DevTools/npm-publish@v1
with:
check-version: true
package: './pkg/npm/api/package.json'
token: ${{ secrets.NPM_TOKEN }}
publish-http-api:
runs-on: ubuntu-latest
name: "Publish '@urbit/http-api' if a new version is available"
steps:
- uses: actions/checkout@v2
with:
lfs: true
- uses: actions/setup-node@v2
with:
node-version: '14'
- run: 'npm install'
working-directory: 'pkg/npm/http-api'
- uses: JS-DevTools/npm-publish@v1
with:
check-version: true
package: './pkg/npm/http-api/package.json'
token: ${{ secrets.NPM_TOKEN }}
publish-eslint-config:
runs-on: ubuntu-latest
name: "Publish '@urbit/eslint-config' if a new version is available"
steps:
- uses: actions/checkout@v2
with:
lfs: true
- uses: actions/setup-node@v2
with:
node-version: '14'
- run: 'npm install'
working-directory: 'pkg/npm/eslint-config'
- uses: JS-DevTools/npm-publish@v1
with:
check-version: true
package: './pkg/npm/eslint-config/package.json'
token: ${{ secrets.NPM_TOKEN }}

4
bin/solid.pill
View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1
oid sha256:6b4b198b552066fdee2a694a3134bf641b20591bebda21aa90920f4107f04f20
size 9065500
oid sha256:fd9f630f51cb104cd2042ef231b78e802a8fd31bbd0a90ced75c7ebee792647a
size 9940591

7
nix/overlays/native.nix
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
];
});
}

3
nix/pkgs/hs/default.nix
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"

13
nix/pkgs/lmdb/darwin-fsync.patch Normal file
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();
}
}

7
pkg/arvo/README.md
View File

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

4
pkg/arvo/app/chat-cli.hoon
View File

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

2
pkg/arvo/app/chat-hook.hoon
View File

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

6
pkg/arvo/app/chat-store.hoon
View File

@ -278,7 +278,7 @@
=/ app-rid=resource
(path-to-resource path)
=/ group-rid=resource
(fall (group-from-app-resource:met %graph app-rid) [nobody %bad-group])
(fall (peek-group:met %graph app-rid) [nobody %bad-group])
=/ group=(unit group)
(scry-group:grp group-rid)
:- (add-graph app-rid mailbox)
@ -293,12 +293,12 @@
|= group=resource
^- card
=- [%pass / %agent [our.bol %group-store] %poke -]
group-update+!>([%remove-group group ~])
group-update-0+!>([%remove-group group ~])
::
++ poke-graph-store
|= =update:graph-store
^- card
[%pass / %agent [our.bol %graph-store] %poke %graph-update !>(update)]
[%pass / %agent [our.bol %graph-store] %poke %graph-update-0 !>(update)]
::
++ letter-to-contents
|= =letter:store

578
pkg/arvo/app/contact-hook.hoon
View File

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

69
pkg/arvo/app/contact-pull-hook.hoon Normal file
View File

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

134
pkg/arvo/app/contact-push-hook.hoon Normal file
View File

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

490
pkg/arvo/app/contact-store.hoon
View File

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

349
pkg/arvo/app/contact-view.hoon
View File

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

8
pkg/arvo/app/dbug.hoon
View File

@ -593,10 +593,10 @@
%& (ship p.lane)
::
%|
?~ l=((soft ,[=@tas =@if =@ud]) (cue p.lane))
s+(scot %x p.lane)
=, u.l
(tape "%{(trip tas)}, {(scow %if if)}, {(scow %ud ud)}")
%- tape
=/ ip=@if (end [0 32] p.lane)
=/ pt=@ud (cut 0 [32 16] p.lane)
"{(scow %if ip)}:{((d-co:co 1) pt)} ({(scow %ux p.lane)})"
==
==
::

60
pkg/arvo/app/demo-pull-hook.hoon Normal file
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]
--

65
pkg/arvo/app/demo-push-hook.hoon Normal file
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)
::
--

100
pkg/arvo/app/demo-store.hoon Normal file
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
--

10
pkg/arvo/app/file-server.hoon
View File

@ -213,6 +213,9 @@
(lowercase (weld path.content.u.content suffix.u.content))
==
?. .^(? %cu scry-path) [not-found:gen %.n]
?: ?=([~ %woff2] ext.req-line)
:_ public.u.content
[[200 [['content-type' '/font/woff2'] ~]] `.^(octs %cx scry-path)]
=/ file (as-octs:mimes:html .^(@ %cx scry-path))
:_ public.u.content
?+ ext.req-line not-found:gen
@ -237,7 +240,12 @@
=/ mime-type=@t (rsh 3 (crip <p.u.data>))
:: Should maybe inspect to see how long cache should hold
::
[[200 ['content-type' mime-type] max-1-da:gen ~] `q.u.data]
=/ headers
:~ content-type+mime-type
max-1-da:gen
'Service-Worker-Allowed'^'/'
==
[[200 headers] `q.u.data]
==
::
++ lowercase

5
pkg/arvo/app/glob.hoon
View File

@ -5,7 +5,7 @@
/- glob
/+ default-agent, verb, dbug
|%
++ hash 0v1.39us5.oj5a9.9as9u.od9db.0dipj
++ hash 0v6.8mn05.16g61.46lkc.lgddc.3ifug
+$ state-0 [%0 hash=@uv glob=(unit (each glob:glob tid=@ta))]
+$ all-states
$% state-0
@ -105,12 +105,15 @@
(cat 3 js-name '.js')
=+ .^(js=@t %cx :(weld home /app/landscape/js/bundle /[js-name]/js))
=+ .^(map=@t %cx :(weld home /app/landscape/js/bundle /[map-name]/map))
=+ .^(sw=@t %cx :(weld home /app/landscape/js/bundle /serviceworker/js))
=+ !<(=js=mime (js-tube !>(js)))
=+ !<(=sw=mime (js-tube !>(sw)))
=+ !<(=map=mime (map-tube !>(map)))
=/ =glob:glob
%- ~(gas by *glob:glob)
:~ /[js-name]/js^js-mime
/[map-name]/map^map-mime
/serviceworker/js^sw-mime
==
=/ =path /(cat 3 'glob-' (scot %uv (sham glob)))/glob
[%pass /make %agent [our.bowl %hood] %poke %drum-put !>([path (jam glob)])]~

12
pkg/arvo/app/goad.hoon
View File

@ -7,6 +7,9 @@
|= force=?
:~ [%pass /gall %arvo %g %goad force ~]
==
+$ state
$@ ~
[%0 ~]
--
|_ =bowl:gall
+* this .
@ -31,8 +34,13 @@
++ on-fail on-fail:def
++ on-init on-init:def
++ on-leave on-leave:def
++ on-load on-load:def
++ on-load
|= =vase
=+ !<(old=state vase)
?^ old `this
[(goad &) this]
::
++ on-peek on-peek:def
++ on-save on-save:def
++ on-save !>([%0 ~])
++ on-watch on-watch:def
--

8
pkg/arvo/app/graph-pull-hook.hoon
View File

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

353
pkg/arvo/app/graph-push-hook.hoon
View File

@ -1,11 +1,7 @@
/+ store=graph-store
/+ metadata
/+ res=resource
/+ graph
/+ group
/+ default-agent
/+ dbug
/+ push-hook
/- *group, metadata=metadata-store
/+ store=graph-store, mdl=metadata, res=resource, graph, group, default-agent,
dbug, verb, push-hook
::
~% %graph-push-hook-top ..part ~
|%
+$ card card:agent:gall
@ -16,86 +12,168 @@
update:store
%graph-update
%graph-pull-hook
0 0
==
::
+$ agent (push-hook:push-hook config)
::
++ is-allowed
|= [=resource:res =bowl:gall requires-admin=?]
^- ?
=/ grp ~(. group bowl)
=/ met ~(. metadata bowl)
=/ group-paths (groups-from-resource:met [%graph (en-path:res resource)])
?~ group-paths %.n
?: requires-admin
(is-admin:grp src.bowl i.group-paths)
?| (is-member:grp src.bowl i.group-paths)
(is-admin:grp src.bowl i.group-paths)
==
::
++ is-allowed-remove
|= [=resource:res indices=(set index:store) =bowl:gall]
^- ?
=/ gra ~(. graph bowl)
?. (is-allowed resource bowl %.n)
%.n
%+ levy
~(tap in indices)
|= =index:store
^- ?
=/ =node:store
(got-node:gra resource index)
?| =(author.post.node src.bowl)
(is-allowed resource bowl %.y)
==
+$ state-null ~
+$ state-zero [%0 marks=(set mark)]
+$ versioned-state
$@ state-null
state-zero
--
::
%- 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 ~(. hook-core bowl)
::
++ on-init on-init:def
++ on-save !>(~)
++ on-load on-load:def
++ on-save !>(state)
++ on-load
|= =vase
=+ !<(old=versioned-state vase)
=? old ?=(~ old)
[%0 ~]
?> ?=(%0 -.old)
`this(state old)
::
++ on-poke on-poke:def
++ on-agent on-agent:def
++ on-watch on-watch:def
++ on-leave on-leave:def
++ on-peek on-peek:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
::
++ should-proxy-update
|= =vase
^- ?
=/ =update:store !<(update:store vase)
?- -.q.update
%add-graph (is-allowed resource.q.update bowl %.y)
%remove-graph (is-allowed resource.q.update bowl %.y)
%add-nodes (is-allowed resource.q.update bowl %.n)
%remove-nodes (is-allowed-remove resource.q.update indices.q.update bowl)
%add-signatures (is-allowed resource.uid.q.update bowl %.n)
%remove-signatures (is-allowed resource.uid.q.update bowl %.y)
%archive-graph (is-allowed resource.q.update bowl %.y)
%unarchive-graph %.n
%add-tag %.n
%remove-tag %.n
%keys %.n
%tags %.n
%tag-queries %.n
%run-updates (is-allowed resource.q.update bowl %.y)
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card _this)
?+ wire (on-arvo:def wire sign-arvo)
::
[%perms @ @ ~]
?> ?=(?(%add %remove) i.t.t.wire)
=* mark i.t.wire
:_ this
(build-permissions:hc mark i.t.t.wire %next)^~
::
[%transform-add @ ~]
=* mark i.t.wire
:_ this
(build-transform-add:hc mark %next)^~
==
::
++ on-fail on-fail:def
++ transform-proxy-update
|= vas=vase
^- (unit vase)
=/ =update:store !<(update:store vas)
=* rid resource.q.update
=. p.update now.bowl
?- -.q.update
%add-nodes
?. (is-allowed-add:hc rid nodes.q.update)
~
=/ mark (get-mark:gra rid)
?~ mark `vas
|^
=/ transform
!< $-([index:store post:store atom ?] [index:store post:store])
%. !>(*indexed-post:store)
.^(tube:clay (scry:hc %cc %home /[u.mark]/transform-add-nodes))
=/ [* result=(list [index:store node:store])]
%+ roll
(flatten-node-map ~(tap by nodes.q.update))
(transform-list transform)
=. nodes.q.update
%- ~(gas by *(map index:store node:store))
result
[~ !>(update)]
::
++ flatten-node-map
|= lis=(list [index:store node:store])
^- (list [index:store node:store])
|^
%- sort-nodes
%+ welp
(turn lis empty-children)
%- zing
%+ turn lis
|= [=index:store =node:store]
^- (list [index:store node:store])
?: ?=(%empty -.children.node)
~
%+ turn
(tap-deep:gra index p.children.node)
empty-children
::
++ empty-children
|= [=index:store =node:store]
^- [index:store node:store]
[index node(children [%empty ~])]
::
++ sort-nodes
|= unsorted=(list [index:store node:store])
^- (list [index:store node:store])
%+ sort unsorted
|= [p=[=index:store *] q=[=index:store *]]
^- ?
(lth (lent index.p) (lent index.q))
--
::
++ transform-list
|= transform=$-([index:store post:store atom ?] [index:store post:store])
|= $: [=index:store =node:store]
[indices=(set index:store) lis=(list [index:store node:store])]
==
=/ l (lent index)
=/ parent-modified=?
%- ~(rep in indices)
|= [i=index:store out=_|]
?: out out
=/ k (lent i)
?: (lte l k)
%.n
=((swag [0 k] index) i)
=/ [ind=index:store =post:store]
(transform index post.node now.bowl parent-modified)
:- (~(put in indices) index)
(snoc lis [ind node(post post)])
--
::
%remove-nodes
?. (is-allowed-remove:hc resource.q.update indices.q.update)
~
`vas
::
%add-graph ~
%remove-graph ~
%add-signatures ~
%remove-signatures ~
%archive-graph ~
%unarchive-graph ~
%add-tag ~
%remove-tag ~
%keys ~
%tags ~
%tag-queries ~
%run-updates ~
==
::
++ resource-for-update resource-for-update:gra
::
++ initial-watch
|= [=path =resource:res]
^- vase
?> (is-allowed resource bowl %.n)
?> (is-allowed:hc resource)
!> ^- update:store
?~ path
:: new subscribe
@ -113,7 +191,17 @@
|= =vase
^- [(list card) agent]
=/ =update:store !<(update:store vase)
?+ -.q.update [~ this]
?+ -.q.update [~ this]
%add-graph
?~ mark.q.update `this
=* mark u.mark.q.update
?: (~(has in marks) mark) `this
:_ this(marks (~(put in marks) mark))
:~ (build-permissions:hc mark %add %sing)
(build-permissions:hc mark %remove %sing)
(build-transform-add:hc mark %sing)
==
::
%remove-graph
:_ this
[%give %kick ~[resource+(en-path:res resource.q.update)] ~]~
@ -123,3 +211,144 @@
[%give %kick ~[resource+(en-path:res resource.q.update)] ~]~
==
--
^| ^= hook-core
|_ =bowl:gall
+* grp ~(. group bowl)
met ~(. mdl bowl)
gra ~(. graph bowl)
::
++ scry
|= [care=@t desk=@t =path]
%+ weld
/[care]/(scot %p our.bowl)/[desk]/(scot %da now.bowl)
path
::
++ perm-mark-name
|= perm=@t
^- @t
(cat 3 'graph-permissions-' perm)
::
++ perm-mark
|= [=resource:res perm=@t vip=vip-metadata:metadata =indexed-post:store]
^- permissions:store
=- (check vip)
!< check=$-(vip-metadata:metadata permissions:store)
%. !>(indexed-post)
=/ mark (get-mark:gra resource)
?~ mark |=(=vase !>([%no %no %no]))
.^(tube:clay (scry %cc %home /[u.mark]/(perm-mark-name perm)))
::
++ add-mark
|= [=resource:res vip=vip-metadata:metadata =indexed-post:store]
(perm-mark resource %add vip indexed-post)
::
++ remove-mark
|= [=resource:res vip=vip-metadata:metadata =indexed-post:store]
(perm-mark resource %remove vip indexed-post)
::
++ get-permission
|= [=permissions:store is-admin=? writers=(set ship)]
^- permission-level:store
?: is-admin
admin.permissions
?: =(~ writers)
writer.permissions
?: (~(has in writers) src.bowl)
writer.permissions
reader.permissions
::
++ is-allowed
|= =resource:res
=/ group-res=resource:res
(need (peek-group:met %graph resource))
(is-member:grp src.bowl group-res)
::
++ get-roles-writers-variation
|= =resource:res
^- (unit [is-admin=? writers=(set ship) vip=vip-metadata:metadata])
=/ assoc=(unit association:metadata)
(peek-association:met %graph resource)
?~ assoc ~
=/ role=(unit (unit role-tag))
(role-for-ship:grp group.u.assoc src.bowl)
=/ writers=(set ship)
(get-tagged-ships:grp group.u.assoc [%graph resource %writers])
?~ role ~
=/ is-admin=?
?=(?([~ %admin] [~ %moderator]) u.role)
`[is-admin writers vip.metadatum.u.assoc]
::
++ node-to-indexed-post
|= =node:store
^- indexed-post:store
=* index index.post.node
[(snag (dec (lent index)) index) post.node]
::
++ is-allowed-add
|= [=resource:res nodes=(map index:store node:store)]
^- ?
%- (bond |.(%.n))
%+ biff (get-roles-writers-variation resource)
|= [is-admin=? writers=(set ship) vip=vip-metadata:metadata]
%- some
%+ levy ~(tap by nodes)
|= [=index:store =node:store]
=/ parent-index=index:store
(scag (dec (lent index)) index)
?: (~(has by nodes) parent-index) %.y
?. =(author.post.node src.bowl)
%.n
=/ =permissions:store
%^ add-mark resource vip
(node-to-indexed-post node)
=/ =permission-level:store
(get-permission permissions is-admin writers)
?- permission-level
%yes %.y
%no %.n
::
%self
=/ parent-node=node:store
(got-node:gra resource parent-index)
=(author.post.parent-node src.bowl)
==
::
++ is-allowed-remove
|= [=resource:res indices=(set index:store)]
^- ?
%- (bond |.(%.n))
%+ biff (get-roles-writers-variation resource)
|= [is-admin=? writers=(set ship) vip=vip-metadata:metadata]
%- some
%+ levy ~(tap by indices)
|= =index:store
=/ =node:store
(got-node:gra resource index)
=/ =permissions:store
%^ remove-mark resource vip
(node-to-indexed-post node)
=/ =permission-level:store
(get-permission permissions is-admin writers)
?- permission-level
%yes %.y
%no %.n
%self =(author.post.node src.bowl)
==
::
++ build-permissions
|= [=mark kind=?(%add %remove) mode=?(%sing %next)]
^- card
=/ =wire /perms/[mark]/[kind]
=/ =mood:clay [%c da+now.bowl /[mark]/(perm-mark-name kind)]
=/ =rave:clay ?:(?=(%sing mode) [mode mood] [mode mood])
[%pass wire %arvo %c %warp our.bowl %home `rave]
::
++ build-transform-add
|= [=mark mode=?(%sing %next)]
^- card
=/ =wire /transform-add/[mark]
=/ =mood:clay [%c da+now.bowl /[mark]/transform-add-nodes]
=/ =rave:clay ?:(?=(%sing mode) [mode mood] [mode mood])
[%pass wire %arvo %c %warp our.bowl %home `rave]
--

52
pkg/arvo/app/graph-store.hoon
View File

@ -1,7 +1,7 @@
:: graph-store [landscape]
::
::
/+ store=graph-store, sigs=signatures, res=resource, default-agent, dbug,
/+ store=graph-store, sigs=signatures, res=resource, default-agent, dbug, verb,
*migrate
~% %graph-store-top ..part ~
|%
@ -25,6 +25,7 @@
=* state -
::
%- agent:dbug
%+ verb |
^- agent:gall
~% %graph-store-agent ..card ~
|_ =bowl:gall
@ -206,7 +207,7 @@
++ give
|= =update-0:store
^- (list card)
[%give %fact ~ [%graph-update !>([%0 now.bowl update-0])]]~
[%give %fact ~ [%graph-update-0 !>([%0 now.bowl update-0])]]~
--
::
++ on-poke
@ -217,7 +218,7 @@
?> (team:title our.bowl src.bowl)
=^ cards state
?+ mark (on-poke:def mark vase)
%graph-update (graph-update !<(update:store vase))
%graph-update-0 (graph-update !<(update:store vase))
%noun (debug !<(debug-input vase))
%import (poke-import q.vase)
==
@ -258,6 +259,7 @@
?& !(~(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]
@ -385,14 +387,14 @@
::
?~ t.index
=* p post.node
?~ hash.p node(signatures.post *signatures:store)
=/ =validated-portion:store
[parent-hash author.p time-sent.p contents.p]
=/ =hash:store `@ux`(sham validated-portion)
?~ hash.p node(signatures.post *signatures:store)
~| "signatures do not match the calculated hash"
?> (are-signatures-valid:sigs our.bowl signatures.p hash now.bowl)
~| "hash of post does not match calculated hash"
?> =(hash u.hash.p)
~| "signatures do not match the calculated hash"
?> (are-signatures-valid:sigs our.bowl signatures.p hash now.bowl)
node
:: recurse children
::
@ -645,7 +647,7 @@
[cards state]
=* update upd.i.updates
=^ crds state
%- graph-update
%- graph-update
^- update:store
?- -.q.update
%add-graph update(resource.q resource)
@ -659,7 +661,7 @@
++ give
|= [paths=(list path) update=update-0:store]
^- (list card)
[%give %fact paths [%graph-update !>([%0 now.bowl update])]]~
[%give %fact paths [%graph-update-0 !>([%0 now.bowl update])]]~
--
::
++ debug
@ -674,21 +676,21 @@
|= [=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)
==
==
%empty %.y
%graph ^$(graph p.children.node)
== ==
::
++ poke-import
|= arc=*
@ -861,15 +863,15 @@
``noun+!>(q.u.result)
::
[%x %keys ~]
:- ~ :- ~ :- %graph-update
:- ~ :- ~ :- %graph-update-0
!>(`update:store`[%0 now.bowl [%keys ~(key by graphs)]])
::
[%x %tags ~]
:- ~ :- ~ :- %graph-update
:- ~ :- ~ :- %graph-update-0
!>(`update:store`[%0 now.bowl [%tags ~(key by tag-queries)]])
::
[%x %tag-queries ~]
:- ~ :- ~ :- %graph-update
:- ~ :- ~ :- %graph-update-0
!>(`update:store`[%0 now.bowl [%tag-queries tag-queries]])
::
[%x %graph @ @ ~]
@ -878,7 +880,7 @@
=/ result=(unit marked-graph:store)
(~(get by graphs) [ship term])
?~ result [~ ~]
:- ~ :- ~ :- %graph-update
:- ~ :- ~ :- %graph-update-0
!> ^- update:store
:+ %0
now.bowl
@ -894,7 +896,7 @@
?~ result
~& no-archived-graph+[ship term]
[~ ~]
:- ~ :- ~ :- %graph-update
:- ~ :- ~ :- %graph-update-0
!> ^- update:store
:+ %0
now.bowl
@ -911,7 +913,7 @@
=/ graph=(unit marked-graph:store)
(~(get by graphs) [ship term])
?~ graph [~ ~]
:- ~ :- ~ :- %graph-update
:- ~ :- ~ :- %graph-update-0
!> ^- update:store
:+ %0 now.bowl
:+ %add-nodes
@ -938,7 +940,7 @@
(turn t.t.t.t.path (cury slav %ud))
=/ node=(unit node:store) (get-node ship term index)
?~ node [~ ~]
:- ~ :- ~ :- %graph-update
:- ~ :- ~ :- %graph-update-0
!> ^- update:store
:+ %0
now.bowl
@ -958,7 +960,7 @@
=/ graph
(get-node-children ship term parent)
?~ graph [~ ~]
:- ~ :- ~ :- %graph-update
:- ~ :- ~ :- %graph-update-0
!> ^- update:store
:+ %0
now.bowl
@ -989,7 +991,7 @@
=/ children
(get-node-children ship term index)
?~ children [~ ~]
:- ~ :- ~ :- %graph-update
:- ~ :- ~ :- %graph-update-0
!> ^- update:store
:+ %0
now.bowl
@ -1016,7 +1018,7 @@
?- -.children.u.node
%empty [~ ~]
%graph
:- ~ :- ~ :- %graph-update
:- ~ :- ~ :- %graph-update-0
!> ^- update:store
:+ %0
now.bowl

9
pkg/arvo/app/group-pull-hook.hoon
View File

@ -14,6 +14,8 @@
update:store
%group-update
%group-push-hook
0 0
%.n
==
::
--
@ -28,6 +30,7 @@
+* this .
def ~(. (default-agent this %|) bowl)
dep ~(. (default:pull-hook this config) bowl)
grp ~(. grpl bowl)
::
++ on-init on-init:def
++ on-save !>(~)
@ -42,11 +45,15 @@
++ 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
^- (unit path)
`/
::
++ resource-for-update resource-for-update:grp
--

118
pkg/arvo/app/group-push-hook.hoon
View File

@ -17,6 +17,7 @@
update:store
%group-update
%group-pull-hook
0 0
==
::
+$ agent (push-hook:push-hook config)
@ -36,7 +37,73 @@
++ on-init on-init:def
++ on-save !>(~)
++ on-load on-load:def
++ on-poke on-poke:def
++ on-poke
|= [=mark =vase]
^- (quip card _this)
|^
?. =(mark %sane)
(on-poke:def mark vase)
[(sane !<(?(%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-0+!>(update)
[%pass /sane %agent [our.bowl %group-store] %poke -]
::
++ get-subscribers-for-group
|= rid=resource
^- (set ship)
=/ target=path
(en-path:resource rid)
%- ~(gas in *(set ship))
%+ murn
~(val by sup.bowl)
|= [her=ship =path]
^- (unit ship)
?. =(path resource+target)
~
`her
--
++ on-agent on-agent:def
++ on-watch on-watch:def
++ on-leave on-leave:def
@ -44,12 +111,12 @@
++ on-arvo on-arvo:def
++ on-fail on-fail:def
::
++ should-proxy-update
|= =vase
=/ =update:store
!<(update:store vase)
++ transform-proxy-update
|= vas=vase
^- (unit vase)
=/ =update:store !<(update:store vas)
?: ?=(%initial -.update)
%.n
~
|^
=/ role=(unit (unit role-tag))
(role-for-ship:grp resource.update src.bowl)
@ -62,25 +129,38 @@
%moderator moderator
%janitor member
==
::
++ member
?: ?=(%add-members -.update)
=(~(tap in ships.update) ~[src.bowl])
?: ?=(%remove-members -.update)
=(~(tap in ships.update) ~[src.bowl])
%.n
?: ?| ?& ?=(%add-members -.update)
=(~(tap in ships.update) ~[src.bowl])
==
?& ?=(%remove-members -.update)
=(~(tap in ships.update) ~[src.bowl])
== ==
`vas
~
::
++ admin
!?=(?(%remove-group %add-group) -.update)
?. ?=(?(%remove-group %add-group) -.update)
`vas
~
::
++ moderator
?= $? %add-members %remove-members
%add-tag %remove-tag ==
-.update
?: ?=(?(%add-members %remove-members %add-tag %remove-tag) -.update)
`vas
~
::
++ non-member
?& ?=(%add-members -.update)
(can-join:grp resource.update src.bowl)
=(~(tap in ships.update) ~[src.bowl])
==
?: ?& ?=(%add-members -.update)
(can-join:grp resource.update src.bowl)
=(~(tap in ships.update) ~[src.bowl])
==
`vas
~
--
::
++ resource-for-update resource-for-update:grp
::
++ take-update
|= =vase
^- [(list card) agent]

185
pkg/arvo/app/group-store.hoon
View File

@ -29,34 +29,32 @@
:: Modify the group. Further documented in /sur/group-store.hoon
::
::
/- *group, *contact-view
/+ store=group-store, default-agent, verb, dbug, resource, *migrate
/- *group
/+ store=group-store, default-agent, verb, dbug, resource, *migrate, agentio
|%
+$ card card:agent:gall
::
+$ versioned-state
$% state-zero
state-one
state-two
==
::
+$ state-zero
$: %0
=groups:state-zero:store
==
::
[%0 *]
::
+$ state-one
$: %1
=groups
=groups:groups-state-one
==
::
+$ diff
$% [%group-update update:store]
[%group-initial groups]
+$ state-two
$: %2
=groups
==
--
::
=| state-one
=| state-two
=* state -
::
%- agent:dbug
@ -74,90 +72,37 @@
++ on-load
|= =old=vase
=/ old !<(versioned-state old-vase)
?: ?=(%1 -.old)
`this(state old)
|^
:- :~ [%pass / %agent [our.bowl dap.bowl] %poke %noun !>(%perm-upgrade)]
kick-all
==
=* paths ~(key by groups.old)
=/ [unmanaged=(list path) managed=(list path)]
(skid ~(tap in paths) |=(=path =('~' (snag 0 path))))
=. groups (all-unmanaged unmanaged)
=. groups (all-managed managed)
this
::
++ all-managed
|= paths=(list path)
^+ groups
?~ paths
groups
=/ [rid=resource =group]
(migrate-group i.paths)
%= $
paths t.paths
::
groups
(~(put by groups) rid group)
?- -.old
%2 `this(state old)
::
%1
%_ $
-.old %2
groups.old (groups-1-to-2 groups.old)
==
::
%0 $(old *state-two)
==
::
++ all-unmanaged
|= paths=(list path)
^+ groups
?~ paths
groups
?: |(=(/~/default i.paths) =(4 (lent i.paths)))
$(paths t.paths)
=/ [=resource =group]
(migrate-unmanaged i.paths)
%= $
paths t.paths
::
groups
(~(put by groups) resource group)
==
++ kick-all
^- card
:+ %give %kick
:_ ~
%~ tap by
%+ roll ~(val by sup.bowl)
|= [[=ship pax=path] paths=(set path)]
(~(put in paths) pax)
::
++ migrate-unmanaged
|= pax=path
^- [resource group]
=/ members=(set ship)
(~(got by groups.old) pax)
=| =invite:policy
?> ?=(^ pax)
=/ rid=resource
(resource-from-old-path t.pax)
++ groups-1-to-2
|= =groups:groups-state-one
^+ ^groups
%- ~(run by groups)
|= =group:groups-state-one
=/ =tags
(~(put ju *tags) %admin entity.rid)
:- rid
[members tags invite %.y]
::
++ resource-from-old-path
|= pax=path
^- resource
?> ?=([@ @ *] pax)
=/ ship
(slav %p i.pax)
[ship i.t.pax]
::
++ migrate-group
|= pax=path
=/ members
(~(got by groups.old) pax)
=| =invite:policy
=/ rid=resource
(resource-from-old-path pax)
=/ =tags
(~(put ju *tags) %admin entity.rid)
[rid members tags invite %.n]
(tags-1-to-2 tags.group)
[members.group tags [policy hidden]:group]
::
++ tags-1-to-2
|= =tags:groups-state-one
^- ^tags
%- ~(gas by *^tags)
%+ murn
~(tap by tags)
|= [=tag:groups-state-one ships=(set ship)]
?^ tag ~
`[tag ships]
--
::
++ on-poke
@ -166,7 +111,9 @@
?> (team:title our.bowl src.bowl)
=^ cards state
?+ mark (on-poke:def mark vase)
?(%group-update %group-action)
%sane (poke-sane:gc !<(?(%check %fix) vase))
::
?(%group-update-0 %group-action)
(poke-group-update:gc !<(update:store vase))
::
%import
@ -180,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
::
@ -189,17 +136,7 @@
^- (unit (unit cage))
?+ path (on-peek:def path)
[%y %groups ~]
=/ =arch
:- ~
%- malt
%+ turn
~(tap by groups)
|= [rid=resource *]
^- [@ta ~]
=/ group=^path
(en-path:resource rid)
[(spat group) ~]
``noun+!>(arch)
``noun+!>(~(key by groups))
::
[%x %groups %ship @ @ ~]
=/ rid=(unit resource)
@ -254,6 +191,7 @@
--
::
|_ bol=bowl:gall
+* io ~(. agentio bol)
++ peek-group
|= rid=resource
^- (unit group)
@ -278,13 +216,34 @@
(~(has in ban-ranks.policy) (clan:title ship))
==
==
++ poke-sane
|= input=?(%check %fix)
^- (quip card _state)
=; cards=(list card)
?: =(%check input)
~& cards
`state
[cards state]
%+ roll ~(tap in ~(key by groups))
|= [rid=resource out=(list card)]
?. ?& =(entity.rid our.bol)
!(~(has in members:(~(got by groups) rid)) our.bol)
==
out
=/ =wire
sane+(en-path:resource rid)
=* poke-self ~(poke-self pass:io wire)
%+ weld out
:~ (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
|= arc=*
^- (quip card _state)
|^
=/ sty=state-one
[%1 (remake-groups ;;((tree [resource tree-group]) +.arc))]
=/ sty=state-two
[%2 (remake-groups ;;((tree [resource tree-group]) +.arc))]
:_ sty
%+ roll ~(tap by groups.sty)
|= [[rid=resource grp=group] out=(list card)]
@ -294,11 +253,8 @@
|= [recipient=@p out=(list card)]
?: =(recipient our.bol)
out
:_ out
%- poke-contact
:* %invite rid recipient
(crip "Rejoin disconnected group {<entity.rid>}/{<name.rid>}")
==
:: TODO: figure out contacts integration
out
:_ out
(try-rejoin rid 0)
::
@ -342,7 +298,7 @@
|= [rid=resource nack-count=@ud]
^- card
=/ =cage
:- %group-update
:- %group-update-0
!> ^- update:store
[%add-members rid (sy our.bol ~)]
=/ =wire
@ -620,11 +576,6 @@
|= =action:store
^- card
[%pass / %agent [our.bol %group-store] %poke %group-action !>(action)]
::
++ poke-contact
|= act=contact-view-action
^- card
[%pass / %agent [our.bol %contact-view] %poke %contact-view-action !>(act)]
:: +send-diff: update subscribers of new state
::
:: We only allow subscriptions on /groups
@ -632,6 +583,6 @@
++ send-diff
|= =update:store
^- (list card)
[%give %fact ~[/groups] %group-update !>(update)]~
[%give %fact ~[/groups] %group-update-0 !>(update)]~
::
--

281
pkg/arvo/app/group-view.hoon Normal file
View File

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

55
pkg/arvo/app/hark-graph-hook.hoon
View File

@ -1,7 +1,7 @@
:: hark-graph-hook: notifications for graph-store [landscape]
::
/- post, group-store, metadata-store, hook=hark-graph-hook, store=hark-store
/+ resource, metadata, default-agent, dbug, graph-store, graph, grouplib=group, store=hark-store
/- post, group-store, metadata=metadata-store, hook=hark-graph-hook, store=hark-store
/+ resource, mdl=metadata, default-agent, dbug, graph-store, graph, grouplib=group, store=hark-store
::
::
~% %hark-graph-hook-top ..part ~
@ -24,8 +24,6 @@
watch-on-self=_&
==
::
+$ notif-kind
[name=@t parent-lent=@ud mode=?(%each %count %none) watch=?]
::
++ scry
|* [[our=@p now=@da] =mold p=path]
@ -53,7 +51,7 @@
+* this .
ha ~(. +> bowl)
def ~(. (default-agent this %|) bowl)
met ~(. metadata bowl)
met ~(. mdl bowl)
grp ~(. grouplib bowl)
gra ~(. graph bowl)
::
@ -184,7 +182,7 @@
~[watch-graph:ha]
::
%fact
?. ?=(%graph-update p.cage.sign)
?. ?=(%graph-update-0 p.cage.sign)
(on-agent:def wire sign)
=^ cards state
(graph-update !<(update:graph-store q.cage.sign))
@ -223,11 +221,11 @@
|= [=index:graph-store out=(list card)]
=| =indexed-post:graph-store
=. index.p.indexed-post index
=+ !<(u-notif-kind=(unit notif-kind) (tube !>(indexed-post)))
=+ !<(u-notif-kind=(unit notif-kind:hook) (tube !>(indexed-post)))
?~ u-notif-kind out
=* notif-kind u.u-notif-kind
=/ =stats-index:store
[%graph rid (scag parent-lent.notif-kind index)]
[%graph rid (scag parent.index-len.notif-kind index)]
?. ?=(%each mode.notif-kind) out
:_ out
(poke-hark %read-each stats-index index)
@ -272,14 +270,14 @@
rid=resource
==
=/ group=(unit resource)
(group-from-app-resource:met %graph rid)
(peek-group:met %graph rid)
?~ group
~& no-group+rid
`state
=/ metadata=(unit metadata:metadata-store)
(peek-metadata:met %graph u.group rid)
?~ metadata `state
abet:check:(abed:handle-update:ha rid nodes u.group module.u.metadata)
=/ metadatum=(unit metadatum:metadata)
(peek-metadatum:met %graph rid)
?~ metadatum `state
abet:check:(abed:handle-update:ha rid nodes u.group module.u.metadatum)
--
::
++ on-peek on-peek:def
@ -300,7 +298,7 @@
--
::
|_ =bowl:gall
+* met ~(. metadata bowl)
+* met ~(. mdl bowl)
grp ~(. grouplib bowl)
gra ~(. graph bowl)
::
@ -344,7 +342,7 @@
|= rid=resource
^- ?
=/ group-rid=(unit resource)
(group-from-app-resource:met %graph rid)
(peek-group:met %graph rid)
?~ group-rid %.n
?| !(is-managed:grp u.group-rid)
&(watch-on-self =(our.bowl entity.rid))
@ -382,8 +380,12 @@
update-core(hark-pokes [action hark-pokes])
::
++ new-watch
|= =index:graph-store
update-core(new-watches [index new-watches])
|= [=index:graph-store =watch-for:hook =index-len:hook]
=? new-watches =(%siblings watch-for)
[(scag parent.index-len index) new-watches]
=? new-watches =(%children watch-for)
[(scag self.index-len index) new-watches]
update-core
::
++ check
|- ^+ update-core
@ -411,7 +413,7 @@
|= =node:graph-store
^+ update-core
=. update-core (check-node-children node)
=+ !< notif-kind=(unit notif-kind)
=+ !< notif-kind=(unit notif-kind:hook)
(get-conversion !>([0 post.node]))
?~ notif-kind
update-core
@ -421,11 +423,11 @@
name.u.notif-kind
=* not-kind u.notif-kind
=/ parent=index:post
(scag parent-lent.not-kind index.post.node)
(scag parent.index-len.not-kind index.post.node)
=/ notif-index=index:store
[%graph group rid module desc parent]
?: =(our.bowl author.post.node)
(self-post node notif-index [mode watch]:not-kind)
(self-post node notif-index not-kind)
=. update-core
(update-unread-count not-kind notif-index [time-sent index]:post.node)
=? update-core
@ -438,7 +440,7 @@
update-core
::
++ update-unread-count
|= [=notif-kind =index:store time=@da ref=index:graph-store]
|= [=notif-kind:hook =index:store time=@da ref=index:graph-store]
=/ =stats-index:store
(to-stats-index:store index)
?- mode.notif-kind
@ -450,19 +452,18 @@
++ self-post
|= $: =node:graph-store
=index:store
mode=?(%count %each %none)
watch=?
=notif-kind:hook
==
^+ update-core
?: ?=(%none mode) update-core
?: ?=(%none mode.notif-kind) update-core
=/ =stats-index:store
(to-stats-index:store index)
=. update-core
(hark %seen-index time-sent.post.node stats-index)
=? update-core ?=(%count mode)
=? update-core ?=(%count mode.notif-kind)
(hark %read-count stats-index)
=? update-core &(watch watch-on-self)
(new-watch index.post.node)
=? update-core watch-on-self
(new-watch index.post.node [watch-for index-len]:notif-kind)
update-core
::
++ add-unread

14
pkg/arvo/app/hark-group-hook.hoon
View File

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

144
pkg/arvo/app/hark-store.hoon
View File

@ -22,6 +22,8 @@
state:state-one:store
state-2
state-3
state-4
state-5
==
+$ unread-stats
[indices=(set index:graph-store) last=@da]
@ -37,13 +39,19 @@
==
::
+$ state-2
[%2 base-state]
[%2 state-two:store]
::
+$ state-3
[%3 base-state]
[%3 state-two:store]
::
+$ state-4
[%4 base-state]
::
+$ state-5
[%5 base-state]
::
+$ inflated-state
$: state-3
$: state-5
cache
==
:: $cache: useful to have precalculated, but can be derived from state
@ -84,9 +92,25 @@
=| cards=(list card)
|^
?- -.old
%3
%5
:- (flop cards)
this(-.state old, +.state (inflate-cache:ha old))
::
%4
%_ $
-.old %5
::
last-seen.old
%- ~(run by last-seen.old)
|=(old=@da (min old now.bowl))
==
::
%3
%_ $
-.old %4
notifications.old (convert-notifications-3 notifications.old)
archive.old (convert-notifications-3 archive.old)
==
::
%2
%_ $
@ -96,7 +120,6 @@
:_ cards
[%pass / %agent [our dap]:bowl %poke noun+!>(%fix-dangling)]
==
::
%1
%_ $
@ -125,7 +148,55 @@
==
==
==
:: discard publish edits
::
++ convert-notifications-3
|= old=notifications:state-two:store
%+ gas:orm *notifications:store
^- (list [@da timebox:store])
%+ murn
(tap:orm:state-two:store old)
|= [time=@da =timebox:state-two:store]
^- (unit [@da timebox:store])
=/ new-timebox=timebox:store
(convert-timebox-3 timebox)
?: =(0 ~(wyt by new-timebox))
~
`[time new-timebox]
::
++ convert-timebox-3
|= =timebox:state-two:store
^- timebox:store
%- ~(gas by *timebox:store)
^- (list [index:store notification:store])
%+ murn
~(tap by timebox)
|= [=index:store =notification:state-two:store]
^- (unit [index:store notification:store])
=/ new-notification=(unit notification:store)
(convert-notification-3 notification)
?~ new-notification ~
`[index u.new-notification]
::
++ convert-notification-3
|= =notification:state-two:store
^- (unit notification:store)
?: ?=(%graph -.contents.notification)
`notification
=/ con=(list group-contents:store)
(convert-group-contents-3 list.contents.notification)
?: =(~ con) ~
=, notification
`[date read %group con]
::
++ convert-group-contents-3
|= con=(list group-contents:state-two:store)
^- (list group-contents:store)
%+ murn con
|= =group-contents:state-two:store
^- (unit group-contents:store)
?. ?=(?(%add-members %remove-members) -.group-contents) ~
`group-contents
::
++ uni-by
|= [a=(set index:graph-store) b=(set index:graph-store)]
=/ merged
@ -149,13 +220,13 @@
::
++ convert-notifications-1
|= old=notifications:state-zero:store
%+ gas:orm *notifications:store
^- (list [@da timebox:store])
%+ gas:orm:state-two:store *notifications:state-two:store
^- (list [@da timebox:state-two:store])
%+ murn
(tap:orm:state-zero:store old)
|= [time=@da =timebox:state-zero:store]
^- (unit [@da timebox:store])
=/ new-timebox=timebox:store
^- (unit [@da timebox:state-two:store])
=/ new-timebox=timebox:state-two:store
(convert-timebox-1 timebox)
?: =(0 ~(wyt by new-timebox))
~
@ -163,21 +234,20 @@
::
++ convert-timebox-1
|= =timebox:state-zero:store
^- timebox:store
%- ~(gas by *timebox:store)
^- (list [index:store notification:store])
^- timebox:state-two:store
%- ~(gas by *timebox:state-two:store)
^- (list [index:store notification:state-two:store])
%+ murn
~(tap by timebox)
|= [=index:state-zero:store =notification:state-zero:store]
^- (unit [index:store notification:store])
^- (unit [index:store notification:state-two:store])
=/ new-index=(unit index:store)
(convert-index-1 index)
=/ new-notification=(unit notification:store)
=/ new-notification=(unit notification:state-two:store)
(convert-notification-1 notification)
?~ new-index ~
?~ new-notification ~
`[u.new-index u.new-notification]
::
++ convert-index-1
|= =index:state-zero:store
@ -192,7 +262,7 @@
::
++ convert-notification-1
|= =notification:state-zero:store
^- (unit notification:store)
^- (unit notification:state-two:store)
?: ?=(%chat -.contents.notification)
~
`notification
@ -222,9 +292,8 @@
%+ turn
~(tap by unreads-count)
|= [=stats-index:store count=@ud]
?> ?=(%graph -.stats-index)
:* stats-index
~(wyt in (~(gut by by-index) stats-index ~))
(~(gut by by-index) stats-index ~)
[%count count]
(~(gut by last-seen) stats-index *time)
==
@ -235,15 +304,32 @@
~(tap by unreads-each)
|= [=stats-index:store indices=(set index:graph-store)]
:* stats-index
~(wyt in (~(gut by by-index) stats-index ~))
(~(gut by by-index) stats-index ~)
[%each indices]
(~(gut by last-seen) stats-index *time)
==
::
++ give-group-unreads
^- (list [stats-index:store stats:store])
%+ murn ~(tap by by-index)
|= [=stats-index:store nots=(set [time index:store])]
?. ?=(%group -.stats-index)
~
:- ~
:* stats-index
nots
[%count 0]
*time
==
::
++ give-unreads
^- update:store
:- %unreads
(weld give-each-unreads give-since-unreads)
;: weld
give-each-unreads
give-since-unreads
give-group-unreads
==
--
::
++ on-peek
@ -359,7 +445,7 @@
::
++ translate
^+ poke-core
?+ -.in poke-core
?- -.in
::
%add-note (add-note +.in)
%archive (do-archive +.in)
@ -377,6 +463,8 @@
%remove-graph (remove-graph +.in)
%set-dnd (set-dnd +.in)
%seen seen
%read-all read-all
::
==
::
:: +| %note
@ -448,6 +536,7 @@
&(=(read read.u.not) !?=(?(%read-note %unread-note) -.in))
~& >> "Inconsistent hark cache, rebuilding"
rebuild-cache
?< &(=(read read.u.not) ?=(?(%read-note %unread-note) -.in))
=. u.tib
(~(put by u.tib) index u.not(read read))
=. notifications
@ -596,6 +685,13 @@
=> (emit autoseen-timer)
poke-core(current-timebox now.bowl)
::
++ read-all
=: unreads-count (~(run by unreads-count) _0)
unreads-each (~(run by unreads-each) _~)
notifications (~(run by notifications) _~)
==
(give:seen:rebuild-cache %read-all ~)
::
++ set-dnd
|= d=?
(give:poke-core(dnd d) %set-dnd d)
@ -682,8 +778,10 @@
==
::
++ inflate-cache
|= state-3
|= state-5
^+ +.state
=. +.state
*cache
=/ nots=(list [p=@da =timebox:store])
(tap:orm notifications)
|- =* outer $

3
pkg/arvo/app/hood.hoon
View File

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

67
pkg/arvo/app/invite-store.hoon
View File

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

2
pkg/arvo/app/landscape/css/index.css
View File

File diff suppressed because one or more lines are too long

BIN
pkg/arvo/app/landscape/fonts/inter-bold.woff2 Normal file
View File

Binary file not shown.

BIN
pkg/arvo/app/landscape/fonts/inter-bolditalic.woff2 Normal file
View File

Binary file not shown.

BIN
pkg/arvo/app/landscape/fonts/inter-italic.woff2 Normal file
View File

Binary file not shown.

BIN
pkg/arvo/app/landscape/fonts/inter-regular.woff2 Normal file
View File

Binary file not shown.

BIN
pkg/arvo/app/landscape/fonts/sourcecodepro-bold.woff2 Normal file
View File

Binary file not shown.

BIN
pkg/arvo/app/landscape/fonts/sourcecodepro-extralight.woff2 Normal file
View File

Binary file not shown.

BIN
pkg/arvo/app/landscape/fonts/sourcecodepro-light.woff2 Normal file
View File

Binary file not shown.

BIN
pkg/arvo/app/landscape/fonts/sourcecodepro-medium.woff2 Normal file
View File

Binary file not shown.

BIN
pkg/arvo/app/landscape/fonts/sourcecodepro-regular.woff2 Normal file
View File

Binary file not shown.

BIN
pkg/arvo/app/landscape/fonts/sourcecodepro-semibold.woff2 Normal file
View File

Binary file not shown.

2
pkg/arvo/app/landscape/index.html
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.5fdbe84c6b57646a6a6b.js"></script>
<script src="/~landscape/js/bundle/index.fbd0f73d77fc99808c22.js"></script>
</body>
</html>

23
pkg/arvo/app/language-server.hoon
View File

@ -5,7 +5,7 @@
easy-print=language-server-easy-print,
rune-snippet=language-server-rune-snippet,
build=language-server-build,
default-agent
default-agent, verb
|%
+$ card card:agent:gall
+$ lsp-req
@ -44,6 +44,7 @@
==
--
^- agent:gall
%+ verb |
=| state-zero
=* state -
=<
@ -69,7 +70,7 @@
|= old-state=vase
^- (quip card _this)
~& > %lsp-upgrade
[~ this(state *state-zero)]
[~ this(state !<(state-zero old-state))]
::
++ on-poke
^+ on-poke:*agent:gall
@ -275,12 +276,14 @@
++ handle-did-open
|= item=text-document-item:lsp-sur
^- (quip card _state)
=/ =path
(uri-to-path:build uri.item)
?: ?=(%sys -.path)
`state
=/ buf=wall
(to-wall (trip text.item))
=. bufs
(~(put by bufs) uri.item buf)
=/ =path
(uri-to-path:build uri.item)
:_ state
%+ weld
(give-rpc-notification (get-diagnostics uri.item))
@ -318,12 +321,12 @@
?~ p.tab-list ~
?~ u.p.tab-list ~
:- ~
%- crip
;: weld
"`"
~(ram re ~(duck easy-print detail.i.u.p.tab-list))
"`"
==
=- (crip :(weld "```hoon\0a" tape "\0a```"))
^- =tape
%- zing
%+ join "\0a"
%+ scag 40
(~(win re ~(duck easy-print detail.i.u.p.tab-list)) 0 140)
::
++ sync-buf
|= [buf=wall changes=(list change:lsp-sur)]

1
pkg/arvo/app/lens.hoon
View File

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

333
pkg/arvo/app/metadata-hook.hoon
View File

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

267
pkg/arvo/app/metadata-pull-hook.hoon Normal file
View File

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

109
pkg/arvo/app/metadata-push-hook.hoon Normal file
View File

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

500
pkg/arvo/app/metadata-store.hoon
View File

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

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

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

186
pkg/arvo/app/settings-store.hoon Normal file
View File

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

9
pkg/arvo/app/spider.hoon
View File

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

43
pkg/arvo/app/test.hoon
View File

@ -40,7 +40,7 @@
=. mar-ok.state %.y
=+ .^(paz=(list path) ct+(en-beam now-beak /mar))
|- ^+ [fex this]
?~ paz [fex this]
?~ paz [(flop fex) this]
=/ xap=path (flop i.paz)
?. ?=([%hoon *] xap)
$(paz t.paz)
@ -63,7 +63,7 @@
?> =(~ app.state)
=. app-ok.state %.y
=+ .^(app-arch=arch cy+(en-beam now-beak /app))
=/ daz ~(tap in ~(key by dir.app-arch))
=/ daz (sort ~(tap in ~(key by dir.app-arch)) |=((pair) !(aor p q)))
|- ^+ [fex this]
?~ daz [fex this]
=/ dap-pax=path /app/[i.daz]/hoon
@ -86,7 +86,7 @@
=. gen-ok.state %.y
=+ .^(paz=(list path) ct+(en-beam now-beak /gen))
|- ^+ [fex this]
?~ paz [fex this]
?~ paz [(flop fex) this]
=/ xap=path (flop i.paz)
?. ?=([%hoon *] xap)
$(paz t.paz)
@ -106,11 +106,18 @@
++ on-peek on-peek:def
++ on-agent on-agent:def
++ on-arvo
=> |%
++ report
|* [=path ok=?]
=/ =tank leaf+"{?:(ok "built " "FAILED")} {(spud path)}"
~>(%slog.[0 tank] same)
--
::
|= [=wire =sign-arvo]
^- [(list card) _this]
?. ?=([%build *] wire)
(on-arvo:def wire sign-arvo)
?. ?=(%writ +<.sign-arvo)
?. ?& ?=([%build *] wire)
?=([%clay %writ *] sign-arvo)
==
(on-arvo:def wire sign-arvo)
=/ =path t.wire
?+ path ~|(path+path !!)
@ -118,41 +125,29 @@
=/ ok
?~ p.sign-arvo |
(~(nest ut -:!>(*agent:gall)) | -:!<(vase q.r.u.p.sign-arvo))
~& ?: ok
agent-built+path
agent-failed+path
%- (report path ok)
=? app-ok.state !ok %.n
=. app.state (~(del in app.state) path)
~? =(~ app.state)
?: app-ok.state
%all-agents-built
%some-agents-failed
?:(app-ok.state %all-agents-built %some-agents-failed)
[~ this]
::
[%mar *]
=/ ok ?=(^ p.sign-arvo)
~& ?: ok
mark-built+path
mark-failed+path
%- (report path ok)
=? mar-ok.state !ok %.n
=. mar.state (~(del in mar.state) path)
~? =(~ mar.state)
?: mar-ok.state
%all-marks-built
%some-marks-failed
?:(mar-ok.state %all-marks-built %some-marks-failed)
[~ this]
::
[%gen *]
=/ ok ?=(^ p.sign-arvo)
~& ?: ok
generator-built+path
generator-failed+path
%- (report path ok)
=? gen-ok.state !ok %.n
=. gen.state (~(del in gen.state) path)
~? =(~ gen.state)
?: gen-ok.state
%all-generators-built
%some-generators-failed
?:(gen-ok.state %all-generators-built %some-generators-failed)
[~ this]
==
++ on-fail on-fail:def

8
pkg/arvo/gen/demo/add.hoon Normal file
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]

8
pkg/arvo/gen/demo/ini.hoon Normal file
View File

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

8
pkg/arvo/gen/demo/run.hoon Normal file
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]

8
pkg/arvo/gen/demo/sub.hoon Normal file
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]

2
pkg/arvo/gen/graph-store/add-graph.hoon
View File

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

2
pkg/arvo/gen/graph-store/add-post.hoon
View File

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

2
pkg/arvo/gen/graph-store/add-signatures.hoon
View File

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

2
pkg/arvo/gen/graph-store/add-tag.hoon
View File

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

2
pkg/arvo/gen/graph-store/archive-graph.hoon
View File

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

2
pkg/arvo/gen/graph-store/export-graph.hoon
View File

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

2
pkg/arvo/gen/graph-store/import-graph.hoon
View File

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

2
pkg/arvo/gen/graph-store/remove-graph.hoon
View File

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

2
pkg/arvo/gen/graph-store/remove-nodes.hoon
View File

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

2
pkg/arvo/gen/graph-store/remove-signatures.hoon
View File

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

2
pkg/arvo/gen/graph-store/remove-tag.hoon
View File

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

2
pkg/arvo/gen/graph-store/unarchive-graph.hoon
View File

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

2
pkg/arvo/gen/group-store/allow-ranks.hoon
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)]

2
pkg/arvo/gen/group-store/allow-ships.hoon
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)]

2
pkg/arvo/gen/group-store/ban-ranks.hoon
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)]

2
pkg/arvo/gen/group-store/ban-ships.hoon
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)]

2
pkg/arvo/gen/group-store/create.hoon
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]

2
pkg/arvo/gen/hood/merge.hoon
View File

@ -21,7 +21,7 @@
|^ :- %kiln-merge
^- $@(~ [syd=desk her=ship sud=desk cas=case gem=?(germ %auto)])
?- arg
~ ((slog (turn help-text |=(=@t leaf+(trip t)))) ~)
~ ((slog (turn `wain`help-text |=(=@t leaf+(trip t)))) ~)
[@ @ ~]
=+(arg [sud ?.(=(our her) her (sein:title p.bek now her)) sud (opt-case da+now) gem])
::

8
pkg/arvo/gen/metadata-store/remove.hoon
View File

@ -9,12 +9,12 @@
:: and looking for the entry with an app-path that is similar to the
:: title of the channel
::
/- *metadata-store
/- metadata=metadata-store
/+ resource
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[group=term app=term =path ~] ~]
[[group=term app=term rid=resource ~] ~]
==
:- %metadata-action
^- metadata-action
[%remove (en-path:resource [p.beak group]) app path]
^- action:metadata
[%remove [p.beak group] app rid]

8
pkg/arvo/gen/pull/add.hoon Normal file
View File

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

8
pkg/arvo/gen/push/add.hoon Normal file
View File

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

24
pkg/arvo/gen/tally.hoon
View File

@ -34,10 +34,8 @@
=/ groups=(list [local=? resource:re members=@ud])
%+ murn
%~ tap in
%~ key by
dir:(scry arch %y %group-store /groups)
|= i=@ta
=/ r=resource:re (de-path:re (stab i))
(scry (set resource:re) %y %group-store /groups)
|= r=resource:re
=/ g=(unit group:gr)
%+ scry (unit group:gr)
[%x %group-store [%groups (snoc (en-path:re r) %noun)]]
@ -59,18 +57,28 @@
%~ tap by
%+ scry associations:md
[%x %metadata-store [%group (snoc (en-path:re r) %noun)]]
|= [[* m=md-resource:md] metadata:md]
|= [m=md-resource:md association:md]
::NOTE we only count graphs for now
?. &(=(%graph app-name.m) =(our creator)) ~
`[module (de-path:re app-path.m)]
?. &(=(%graph app-name.m) =(our creator.metadatum)) ~
`[module.metadatum resource.m]
:: for sanity checks
::
=/ real=(set resource:re)
=/ upd=update:ga
%+ scry update:ga
[%x %graph-store /keys/graph-update-0]
?> ?=(%keys -.q.upd)
resources.q.upd
:: count activity per channel
::
=/ activity=(list [resource:re members=@ud (list [resource:re mod=term week=@ud authors=@ud])])
%+ turn crowds
|= [g=resource:re m=@ud]
:+ g m
%+ turn (~(got by channels) g)
%+ murn (~(got by channels) g)
|= [m=term r=resource:re]
?. (~(has in real) r) ~
%- some
:+ r m
::NOTE graph-store doesn't use the full resource-style path here!
=/ upd=update:ga

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

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

21
pkg/arvo/lib/azimuth.hoon
View File

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

265
pkg/arvo/lib/contact-json.hoon
View File

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

186
pkg/arvo/lib/contact-store.hoon Normal file
View File

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

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

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

15
pkg/arvo/lib/gcp.hoon Normal file
View File

@ -0,0 +1,15 @@
/- *gcp
|%
++ token-to-json
|= =token
^- json
=, enjs:format
%+ frond %gcp-token
%: pairs
[%'accessKey' s+access-key.token]
:- %'expiresIn'
%- numb
(div (mul 1.000 expires-in.token) ~s1)
~
==
--

1
pkg/arvo/lib/graph-store.hoon
View File

@ -110,7 +110,6 @@
++ update
|= upd=^update
^- json
?> ?=(%0 -.upd)
|^ (frond %graph-update (pairs ~[(encode q.upd)]))
::
++ encode

37
pkg/arvo/lib/graph-view.hoon
View File

@ -1,4 +1,4 @@
/- sur=graph-view
/- sur=graph-view, store=graph-store
/+ resource, group-store
^?
=< [sur .]
@ -17,6 +17,7 @@
leave+leave
groupify+groupify
eval+so
pending-indices+pending-indices
::invite+invite
==
::
@ -51,6 +52,9 @@
:~ resource+(un dejs:resource)
to+(uf ~ (mu dejs:resource))
==
::
++ pending-indices (op hex (su ;~(pfix fas (more fas dem))))
::
++ invite !!
::
++ associated
@ -60,4 +64,35 @@
==
--
--
::
++ enjs
=, enjs:format
|%
++ action
|= act=^action
^- json
?> ?=(%pending-indices -.act)
%+ frond %pending-indices
%- pairs
%+ turn ~(tap by pending.act)
|= [h=hash:store i=index:store]
^- [@t json]
=/ idx (index i)
?> ?=(%s -.idx)
[p.idx s+(scot %ux h)]
::
++ index
|= i=index:store
^- json
?: =(~ i) s+'/'
=/ j=^tape ""
|-
?~ i [%s (crip j)]
=/ k=json (numb i.i)
?> ?=(%n -.k)
%_ $
i t.i
j (weld j (weld "/" (trip +.k)))
==
--
--

72
pkg/arvo/lib/graph.hoon
View File

@ -11,6 +11,27 @@
(snoc `^path`path %noun)
==
::
++ resource-for-update
|= =vase
^- (list resource)
=/ =update:store !<(update:store vase)
?- -.q.update
%add-graph ~[resource.q.update]
%remove-graph ~[resource.q.update]
%add-nodes ~[resource.q.update]
%remove-nodes ~[resource.q.update]
%add-signatures ~[resource.uid.q.update]
%remove-signatures ~[resource.uid.q.update]
%archive-graph ~[resource.q.update]
%unarchive-graph ~
%add-tag ~
%remove-tag ~
%keys ~
%tags ~
%tag-queries ~
%run-updates ~[resource.q.update]
==
::
++ get-graph
|= res=resource
^- update:store
@ -83,25 +104,38 @@
resources.q.update
::
++ tap-deep
|= =graph:store
|= [=index:store =graph:store]
^- (list [index:store node:store])
=| =index:store
=/ nodes=(list [atom node:store])
(tap:orm:store graph)
|- =* tap-nodes $
^- (list [index:store node:store])
%- zing
%+ turn
nodes
|= [=atom =node:store]
^- (list [index:store node:store])
%+ welp
^- (list [index:store node:store])
[(snoc index atom) node]~
?. ?=(%graph -.children.node)
~
%_ tap-nodes
index (snoc index atom)
nodes (tap:orm:store p.children.node)
%+ roll (tap:orm:store graph)
|= $: [=atom =node:store]
lis=(list [index:store node:store])
==
=/ child-index (snoc index atom)
=/ childless-node node(children [%empty ~])
?: ?=(%empty -.children.node)
(snoc lis [child-index childless-node])
%+ weld
(snoc lis [child-index childless-node])
(tap-deep child-index p.children.node)
::
++ got-deep
|= [=graph:store =index:store]
^- node:store
=/ ind index
?> ?=(^ index)
=/ =node:store (need (get:orm:store graph `atom`i.index))
=. ind t.index
|- ^- node:store
?~ ind
node
?: ?=(%empty -.children.node)
!!
%_ $
ind t.ind
node (need (get:orm:store p.children.node i.ind))
==
::
++ get-mark
|= res=resource
(scry-for ,(unit mark) /graph-mark/(scot %p entity.res)/[name.res])
--

46
pkg/arvo/lib/group-store.hoon
View File

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

92
pkg/arvo/lib/group-view.hoon Normal file
View File

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

88
pkg/arvo/lib/group.hoon
View File

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

9
pkg/arvo/lib/hark/store.hoon
View File

@ -76,6 +76,7 @@
set-dnd+bo
read-count+stats-index
read-each+read-graph-index
read-all+ul
==
--
::
@ -150,7 +151,7 @@
^- json
%- pairs
:~ unreads+(unread unreads.s)
notifications+(numb notifications.s)
notifications+a+(turn ~(tap in notifications.s) notif-ref)
last+(time last-seen.s)
==
++ added
@ -245,11 +246,9 @@
|= =(list ^group-contents)
^- json
:- %a
%+ murn list
%+ turn list
|= =^group-contents
?. ?=(?(%add-members %remove-members) -.group-contents)
~
`(update:enjs:group-store group-contents)
(update:enjs:group-store group-contents)
--
::
++ indexed-notification

16
pkg/arvo/lib/hood/drum.hoon
View File

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

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