ilyakooo0/urbit
1
0
Fork 0
mirror of https://github.com/ilyakooo0/urbit.git synced 2024-12-15 01:52:42 +03:00
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'release/next-sys' into HEAD

Browse Source
This commit is contained in:
Ted Blackman 2021-02-24 13:26:51 -05:00
commit 0452eb92f2
339 changed files with 14747 additions and 10804 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
.github/ISSUE_TEMPLATE/config.yml vendored
View File

@ -1,11 +1,8 @@
blank_issues_enabled: true
contact_links:
- name: Landscape design issue
url: https://github.com/urbit/landscape/issues/new?assignees=&labels=design+issue&template=report-a-design-issue.md&title=
about: Submit non-functionality, design-specific issues to the Landscape team here.
- name: Landscape feature request
url: https://github.com/urbit/landscape/issues/new?assignees=&labels=feature+request&template=feature_request.md&title=
about: Landscape is comprised of Tlon's user applications and client for Urbit. Submit Landscape feature requests here.
- name: Submit a Landscape issue
url: https://github.com/urbit/landscape/issues/new/choose
about: Issues with Landscape (Tlon's flagship client) should be filed at urbit/landscape. This includes groups, chats, collections, notebooks, and more.
- name: urbit-dev mailing list
url: https://groups.google.com/a/urbit.org/g/dev
about: Developer questions and discussions also take place on the urbit-dev mailing list.

39
.github/ISSUE_TEMPLATE/os1-bug-report.md vendored
View File

@ -1,39 +0,0 @@
---
name: Landscape bug report
about: 'Use this template to file a bug for any Landscape app: Chat, Publish, Links, Groups,
Weather or Clock'
title: ''
labels: landscape
assignees: ''
---
**Describe the bug**
A clear and concise description of what the bug is.
**To Reproduce**
Steps to reproduce the behavior:
1. Go to '...'
2. Click on '....'
3. Scroll down to '....'
4. See error
**Expected behavior**
A clear and concise description of what you expected to happen.
**Screenshots**
If applicable, add screenshots to help explain your problem. If possible, please also screenshot your browser's dev console. Here are [Chrome's docs](https://developers.google.com/web/tools/chrome-devtools/open) for using this feature.
**Desktop (please complete the following information):**
- OS: [e.g. MacOS 10.15.3]
- Browser [e.g. chrome, safari]
- Base hash of your urbit ship. Run `+trouble` in Dojo to see this.
**Smartphone (please complete the following information):**
- Device: [e.g. iPhone6]
- OS: [e.g. iOS8.1]
- Browser [e.g. stock browser, safari]
- Base hash of your urbit ship. Run `+trouble` in Dojo to see this.
**Additional context**
Add any other context about the problem here.

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

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

@ -47,7 +47,19 @@ jobs:
steps:
- uses: actions/checkout@v2
# We only want the extra nix config on linux, where it is necessary
# for the docker build. We don't want in on Mac, where it isn't but
# it breaks the nix install. The two `if` clauses should be mutually
# exclusive
- uses: cachix/install-nix-action@v12
with:
extra_nix_config: |
system-features = nixos-test benchmark big-parallel kvm
if: ${{ matrix.os == 'ubuntu-latest' }}
- uses: cachix/install-nix-action@v12
if: ${{ matrix.os != 'ubuntu-latest' }}
- uses: cachix/cachix-action@v8
with:
name: ares
@ -58,6 +70,9 @@ jobs:
- if: ${{ matrix.os == 'ubuntu-latest' }}
run: nix-build -A urbit-tests
- if: ${{ matrix.os == 'ubuntu-latest' }}
run: nix-build -A docker-image
haskell:
strategy:
fail-fast: false

2
.github/workflows/merge.yml vendored
View File

@ -13,5 +13,5 @@ jobs:
with:
type: now
target_branch: release/next-js
github_token: ${{ github.token }}
github_token: ${{ secrets.JANEWAY_BOT_TOKEN }}

51
.github/workflows/release-docker.yml vendored Normal file
View File

@ -0,0 +1,51 @@
name: release-docker
on:
release: null
push:
tags: ['urbit-v*']
jobs:
upload:
strategy:
matrix:
include:
- { os: ubuntu-latest, system: x86_64-linux }
runs-on: ${{ matrix.os }}
steps:
- uses: actions/checkout@v2
- uses: cachix/install-nix-action@v12
with:
extra_nix_config: |
system-features = nixos-test benchmark big-parallel kvm
- uses: cachix/cachix-action@v8
with:
name: ares
authToken: ${{ secrets.CACHIX_AUTH_TOKEN }}
- uses: docker/docker-login-action@v1.8.0
with:
username: ${{ secrets.DOCKERHUB_USERNAME }}
password: ${{ secrets.DOCKERHUB_TOKEN }}
- uses: christian-korneck/update-container-description-action@v1
env:
DOCKER_USER: ${{ secrets.DOCKERHUB_USERNAME }}
DOCKER_PASS: ${{ secrets.DOCKERHUB_TOKEN }}
with:
destination_container_repo: ${{ secrets.DOCKERHUB_USERNAME }}/urbit
provider: dockerhub
short_description: 'Urbit: a clean-slate OS and network for the 21st century'
readme_file: 'pkg/docker-image/README.md'
- run: |
version="$(cat ./pkg/urbit/version)"
image="$(nix-build -A docker-image)"
imageName="$(nix-instantiate --eval -A docker-image.imageName | cut -d'"' -f2)"
imageTag="$(nix-instantiate --eval -A docker-image.imageTag | cut -d'"' -f2)"
# Load the image from the nix-built tarball
docker load -i $image
docker tag "$imageName:$imageTag" ${{secrets.DOCKERHUB_USERNAME }}/urbit:v$version
docker tag "$imageName:$imageTag" ${{secrets.DOCKERHUB_USERNAME }}/urbit:latest
docker push ${{secrets.DOCKERHUB_USERNAME }}/urbit:v$version
docker push ${{secrets.DOCKERHUB_USERNAME }}/urbit:latest

2
.github/workflows/release.yml vendored
View File

@ -20,7 +20,7 @@ jobs:
- uses: cachix/install-nix-action@v12
- uses: cachix/cachix-action@v8
with:
name: ares
name: ${{ secrets.CACHIX_NAME }}
authToken: ${{ secrets.CACHIX_AUTH_TOKEN }}
- uses: google-github-actions/setup-gcloud@v0.2.0

7
default.nix
View File

@ -115,6 +115,8 @@ let
urbit = callPackage ./nix/pkgs/urbit { inherit enableStatic; };
docker-image = callPackage ./nix/pkgs/docker-image { };
hs = callPackage ./nix/pkgs/hs {
inherit enableStatic;
inherit (pkgsCross) haskell-nix;
@ -153,11 +155,12 @@ let
contents = {
"${name}/urbit" = "${urbit}/bin/urbit";
"${name}/urbit-worker" = "${urbit}/bin/urbit-worker";
# temporarily removed for compatibility reasons
# "${name}/urbit-king" = "${urbit-king}/bin/urbit-king";
"${name}/urbit-king" = "${urbit-king}/bin/urbit-king";
};
};
inherit (pkgsNative) skopeo;
# A convenience function for constructing a shell.nix for any of the
# pkgsLocal derivations by automatically propagating any dependencies
# to the nix-shell.

68
nix/pkgs/docker-image/default.nix Normal file
View File

@ -0,0 +1,68 @@
{ urbit, libcap, coreutils, bashInteractive, dockerTools, writeScriptBin, amesPort ? 34343 }:
let
startUrbit = writeScriptBin "start-urbit" ''
#!${bashInteractive}/bin/bash
set -eu
# If the container is not started with the `-i` flag
# then STDIN will be closed and we need to start
# Urbit/vere with the `-t` flag.
ttyflag=""
if [ ! -t 0 ]; then
echo "Running with no STDIN"
ttyflag="-t"
fi
# Check if there is a keyfile, if so boot a ship with its name, and then remove the key
if [ -e *.key ]; then
# Get the name of the key
keynames="*.key"
keys=( $keynames )
keyname=''${keys[0]}
mv $keyname /tmp
# Boot urbit with the key, exit when done booting
urbit $ttyflag -w $(basename $keyname .key) -k /tmp/$keyname -c $(basename $keyname .key) -p ${toString amesPort} -x
# Remove the keyfile for security
rm /tmp/$keyname
rm *.key || true
elif [ -e *.comet ]; then
cometnames="*.comet"
comets=( $cometnames )
cometname=''${comets[0]}
rm *.comet
urbit $ttyflag -c $(basename $cometname .comet) -p ${toString amesPort} -x
fi
# Find the first directory and start urbit with the ship therein
dirnames="*/"
dirs=( $dirnames )
dirname=''${dirnames[0]}
urbit $ttyflag -p ${toString amesPort} $dirname
'';
in dockerTools.buildImage {
name = "urbit";
tag = "v${urbit.version}";
contents = [ bashInteractive urbit startUrbit coreutils ];
runAsRoot = ''
#!${bashInteractive}
mkdir -p /urbit
mkdir -p /tmp
${libcap}/bin/setcap 'cap_net_bind_service=+ep' /bin/urbit
'';
config = {
Cmd = [ "/bin/start-urbit" ];
Env = [ "PATH=/bin" ];
WorkingDir = "/urbit";
Volumes = {
"/urbit" = {};
};
Expose = [ "80/tcp" "${toString amesPort}/udp" ];
};
}

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

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

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

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

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

@ -0,0 +1,131 @@
/- pull-hook
/+ store=contact-store, res=resource, contact, group,
default-agent, dbug, push-hook, agentio, verb
~% %contact-push-hook-top ..part ~
|%
+$ card card:agent:gall
++ config
^- config:push-hook
:* %contact-store
/updates
update:store
%contact-update
%contact-pull-hook
==
::
+$ agent (push-hook:push-hook config)
::
+$ share [%share =ship]
--
::
%- agent:dbug
^- agent:gall
%+ verb |
%- (agent:push-hook config)
^- agent
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
con ~(. contact bowl)
grp ~(. group bowl)
io ~(. agentio bowl)
::
++ on-init
^- (quip card _this)
:_ this
:- %+ poke-our:pass:io %contact-push-hook
:- %push-hook-action
!>(`action:push-hook`[%add [our.bowl %'']])
%+ murn ~(tap in scry-groups:grp)
|= rid=res
?. =(our.bowl entity.rid) ~
?. (is-managed:grp rid) ~
`(poke-self:pass:io push-hook-action+!>([%add rid]))
::
++ on-save !>(~)
++ on-load on-load:def
++ on-poke
|= [=mark =vase]
^- (quip card _this)
?. =(mark %contact-share) (on-poke:def mark vase)
=/ =share !<(share vase)
:_ this :_ ~
?: =(our.bowl src.bowl)
?< =(ship.share our.bowl)
:: proxy poke
%+ poke:pass:io [ship.share dap.bowl]
contact-share+!>([%share our.bowl])
:: accept share
?> =(src.bowl ship.share)
%+ poke-our:pass:io %contact-pull-hook
pull-hook-action+!>([%add src.bowl [src.bowl %$]])
::
++ on-agent on-agent:def
++ on-watch on-watch:def
++ on-leave on-leave:def
++ on-peek on-peek:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
::
++ should-proxy-update
|= =vase
^- ?
=/ =update:store !<(update:store vase)
?- -.update
%initial %.n
%add %.y
%remove %.y
%edit %.y
%allow %.n
%disallow %.n
%set-public %.n
==
::
++ resource-for-update resource-for-update:con
::
++ initial-watch
|= [=path =resource:res]
^- vase
|^
?> (is-allowed:con resource src.bowl)
!> ^- update:store
[%initial rolo %.n]
::
++ rolo
^- rolodex:store
=/ ugroup (scry-group:grp resource)
=/ =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 !>(update)]]~
--
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
?> (team:title our.bowl src.bowl)
|^
=^ cards state
?+ mark (on-poke:def mark vase)
%contact-update (update !<(update:store vase))
%import (import q.vase)
==
[cards this]
::
++ update
|= =update:store
^- (quip card _state)
|^
?- -.update
%initial (handle-initial +.update)
%add (handle-add +.update)
%remove (handle-remove +.update)
%edit (handle-edit +.update)
%allow (handle-allow +.update)
%disallow (handle-disallow +.update)
%set-public (handle-set-public +.update)
==
::
++ handle-initial
|= [rolo=rolodex:store *]
^- (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 !>(update)]~
--
::
++ import
|= arc=*
^- (quip card _state)
:: note: we are purposefully wiping all state before state-4
[~ *state-4]
--
::
|_ bol=bowl:gall
::
::++ poke-json
:: |= =json
:: ^- (quip move _this)
:: ?> (team:title our.bol src.bol)
:: (poke-contact-action (json-to-action json))
::
++ poke-contact-action
|= action=contact-action
^- (quip card _state)
?> (team:title our.bol src.bol)
?- -.action
%create (handle-create +.action)
%delete (handle-delete +.action)
%add (handle-add +.action)
%remove (handle-remove +.action)
%edit (handle-edit +.action)
++ on-peek
|= =path
^- (unit (unit cage))
?+ path (on-peek:def path)
[%x %all ~] ``noun+!>(rolodex)
::
[%x %contact @ ~]
=/ =ship (slav %p i.t.t.path)
=/ contact=(unit contact:store) (~(get by rolodex) ship)
?~ contact [~ ~]
:- ~ :- ~ :- %contact-update
!> ^- update:store
[%add ship u.contact]
::
[%x %allowed-ship @ ~]
=/ =ship (slav %p i.t.t.path)
``noun+!>((~(has in allowed-ships) ship))
::
[%x %is-public ~]
``noun+!>(is-public)
::
[%x %allowed-groups ~]
``noun+!>(allowed-groups)
::
[%x %is-allowed @ @ @ @ ~]
=/ is-personal =(i.t.t.t.t.t.path 'true')
=/ =resource
?: is-personal
[our.bowl %'']
[(slav %p i.t.t.path) i.t.t.t.path]
=/ =ship (slav %p i.t.t.t.t.path)
``json+!>(`json`b+(is-allowed:con resource ship))
==
::
++ poke-import
|= arc=*
^- (quip card _state)
=/ sty=state-three
:- %3
%- remake-map-of-map
;;((tree [path (tree [ship contact])]) +.arc)
[~ sty]
::
++ handle-create
|= =path
^- (quip card _state)
?< (~(has by rolodex) path)
:- (send-diff path [%create path])
state(rolodex (~(put by rolodex) path *contacts))
::
++ handle-delete
|= =path
^- (quip card _state)
?. (~(has by rolodex) path) [~ state]
:- (send-diff path [%delete path])
state(rolodex (~(del by rolodex) path))
::
++ handle-add
|= [=path =ship =contact]
^- (quip card _state)
=/ contacts (~(got by rolodex) path)
?< (~(has by contacts) ship)
=. contacts (~(put by contacts) ship contact)
:- (send-diff path [%add path ship contact])
state(rolodex (~(put by rolodex) path contacts))
::
++ handle-remove
|= [=path =ship]
^- (quip card _state)
=/ contacts (~(got by rolodex) path)
?. (~(has by contacts) ship) [~ state]
=. contacts (~(del by contacts) ship)
:- (send-diff path [%remove path ship])
state(rolodex (~(put by rolodex) path contacts))
::
++ handle-edit
|= [=path =ship =edit-field]
^- (quip card _state)
=/ contacts (~(got by rolodex) path)
=/ contact (~(got by contacts) ship)
=. contact (edit-contact contact edit-field)
=. contacts (~(put by contacts) ship contact)
:- (send-diff path [%edit path ship edit-field])
state(rolodex (~(put by rolodex) path contacts))
::
++ edit-contact
|= [con=contact edit=edit-field]
^- contact
?- -.edit
%nickname con(nickname nickname.edit)
%email con(email email.edit)
%phone con(phone phone.edit)
%website con(website website.edit)
%notes con(notes notes.edit)
%color con(color color.edit)
%avatar con(avatar avatar.edit)
==
::
++ send-diff
|= [pax=path upd=contact-update]
^- (list card)
:~ :*
%give %fact
~[/all /updates [%contacts pax]]
%contact-update !>(upd)
== ==
++ on-leave on-leave:def
++ on-agent on-agent:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
--

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

3
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

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

@ -5,7 +5,7 @@
/- glob
/+ default-agent, verb, dbug
|%
++ hash 0v5.sekq0.8skge.ekt62.i73ig.g5sep
++ hash 0v5.pmklm.qttdl.n8bs0.0tnc4.gg633
+$ state-0 [%0 hash=@uv glob=(unit (each glob:glob tid=@ta))]
+$ all-states
$% state-0

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

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

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

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

26
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
@ -230,7 +231,7 @@
?> ?=(%0 -.update)
=? p.update =(p.update *time) now.bowl
?- -.q.update
%add-graph (add-graph +.q.update)
%add-graph (add-graph p.update +.q.update)
%remove-graph (remove-graph +.q.update)
%add-nodes (add-nodes p.update +.q.update)
%remove-nodes (remove-nodes p.update +.q.update)
@ -247,7 +248,8 @@
==
::
++ add-graph
|= $: =resource:store
|= $: =time
=resource:store
=graph:store
mark=(unit mark:store)
overwrite=?
@ -258,9 +260,13 @@
!(~(has by graphs) resource)
== ==
?> (validate-graph graph mark)
=/ =logged-update:store
[%0 time %add-graph resource graph mark overwrite]
=/ =update-log:store
(gas:orm-log ~ [time logged-update] ~)
:_ %_ state
graphs (~(put by graphs) resource [graph mark])
update-logs (~(put by update-logs) resource (gas:orm-log ~ ~))
update-logs (~(put by update-logs) resource update-log)
archive (~(del by archive) resource)
::
validators
@ -643,6 +649,7 @@
%- graph-update
^- update:store
?- -.q.update
%add-graph update(resource.q resource)
%add-nodes update(resource.q resource)
%remove-nodes update(resource.q resource)
%add-signatures update(resource.uid.q resource)
@ -720,7 +727,8 @@
$: %0
p=time
$= q
$% [%add-nodes =resource:store nodes=(tree [index:store tree-node])]
$% [%add-graph =resource:store =tree-graph mark=(unit ^mark) ow=?]
[%add-nodes =resource:store nodes=(tree [index:store tree-node])]
[%remove-nodes =resource:store indices=(tree index:store)]
[%add-signatures =uid:store signatures=tree-signatures]
[%remove-signatures =uid:store signatures=tree-signatures]
@ -800,6 +808,14 @@
^- logged-update:store
:+ %0 p.t
?- -.q.t
%add-graph
:* %add-graph
resource.q.t
(remake-graph tree-graph.q.t)
mark.q.t
ow.q.t
==
::
%add-nodes
:- %add-nodes
:- resource.q.t

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

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

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

@ -36,7 +36,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+!>(update)
[%pass /sane %agent [our.bowl %group-store] %poke -]
::
++ get-subscribers-for-group
|= rid=resource
^- (set ship)
=/ target=path
(en-path:resource rid)
%- ~(gas in *(set ship))
%+ murn
~(val by sup.bowl)
|= [her=ship =path]
^- (unit ship)
?. =(path resource+target)
~
`her
--
++ on-agent on-agent:def
++ on-watch on-watch:def
++ on-leave on-leave:def
@ -80,15 +146,7 @@
=(~(tap in ships.update) ~[src.bowl])
==
--
::
++ resource-for-update
|= =vase
^- (unit resource)
=/ =update:store
!<(update:store vase)
?: ?=(%initial -.update)
~
`resource.update
++ resource-for-update resource-for-update:grp
::
++ take-update
|= =vase

177
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,6 +111,8 @@
?> (team:title our.bowl src.bowl)
=^ cards state
?+ mark (on-poke:def mark vase)
%sane (poke-sane:gc !<(?(%check %fix) vase))
::
?(%group-update %group-action)
(poke-group-update:gc !<(update:store vase))
::
@ -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+!>([%add-members rid (silt our.bol ~)]))
(poke-self group-update+!>([%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)
::
@ -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

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+!>([%add-members rid (silt our.bowl ~)])
=. jn-core (tx-progress %start)
=> watch-md
watch-groups
::
++ jn-agent
|= [=wire =sign:agent:gall]
^+ jn-core
|^
?+ -.wire ~|("bad %join wire" !!)
%add :: join group
?> ?=(%poke-ack -.sign)
?^ p.sign
(cleanup %no-perms)
=> %- emit
%+ poke-our:(jn-pass-io /pull-groups) %group-pull-hook
pull-hook-action+!>([%add ship rid])
(tx-progress %added)
::
%pull-groups
?> ?=(%poke-ack -.sign)
(ack +.sign)
::
%groups
?+ -.sign !!
%fact (groups-fact +.sign)
%watch-ack (ack +.sign)
%kick watch-groups
==
::
%pull-md
?> ?=(%poke-ack -.sign)
(ack +.sign)
::
%pull-co
?> ?=(%poke-ack -.sign)
(ack +.sign)
::
%share-co
?> ?=(%poke-ack -.sign)
(ack +.sign)
::
%push-co
?> ?=(%poke-ack -.sign)
(ack +.sign)
::
%md
?+ -.sign !!
%fact (md-fact +.sign)
%watch-ack (ack +.sign)
%kick watch-md
==
::
%pull-graphs
?> ?=(%poke-ack -.sign)
%- cleanup
?^(p.sign %strange %done)
==
::
++ groups-fact
|= =cage
?. ?=(%group-update p.cage) jn-core
=+ !<(=update:group-store q.cage)
?. ?=(%initial-group -.update) jn-core
?. =(rid resource.update) jn-core
%- emit-many
=/ cag=^cage pull-hook-action+!>([%add [entity .]:rid])
%- zing
:~ [(poke-our:(jn-pass-io /pull-md) %metadata-pull-hook cag)]~
[(poke-our:(jn-pass-io /pull-co) %contact-pull-hook cag)]~
::
?. scry-is-public:con ~
:_ ~
%+ poke:(jn-pass-io /share-co)
[entity.rid %contact-push-hook]
[%contact-share !>([%share our.bowl])]
==
::
++ md-fact
|= [=mark =vase]
?. ?=(%metadata-update mark) jn-core
=+ !<(=update:metadata vase)
?. ?=(%initial-group -.update) jn-core
?. =(group.update rid) jn-core
=. jn-core (cleanup %done)
?. hidden:(need (scry-group:grp rid)) jn-core
%- emit-many
%+ murn ~(tap by associations.update)
|= [=md-resource:metadata =association:metadata]
^- (unit card)
?. =(app-name.md-resource %graph) ~
=* rid resource.md-resource
:- ~
%+ poke-our:(jn-pass-io /pull-graph) %graph-pull-hook
pull-hook-action+!>([%add [entity .]:rid])
::
++ ack
|= err=(unit tang)
?~ err jn-core
%- (slog u.err)
(cleanup %strange)
::
++ cleanup
|= =progress:view
=. jn-core
(tx-progress progress)
=. joining (~(del by joining) rid)
=. jn-core
(emit (leave-our:(jn-pass-io /groups) %group-store))
(emit (leave-our:(jn-pass-io /md) %metadata-store))
--
--
--

88
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 ~
@ -9,11 +9,17 @@
+$ card card:agent:gall
+$ versioned-state
$% state-0
state-1
==
::
+$ state-0
$: %0
watching=(set [resource index:post])
[%0 base-state-0]
::
+$ state-1
[%1 base-state-0]
::
+$ base-state-0
$: watching=(set [resource index:post])
mentions=_&
watch-on-self=_&
==
@ -36,7 +42,7 @@
::
--
::
=| state-0
=| state-1
=* state -
::
=<
@ -47,7 +53,7 @@
+* this .
ha ~(. +> bowl)
def ~(. (default-agent this %|) bowl)
met ~(. metadata bowl)
met ~(. mdl bowl)
grp ~(. grouplib bowl)
gra ~(. graph bowl)
::
@ -57,13 +63,25 @@
::
++ on-save !>(state)
++ on-load
|= old=vase
|= =vase
^- (quip card _this)
:_ this(state !<(state-0 old))
=+ !<(old=versioned-state vase)
=| cards=(list card)
|-
?: ?=(%0 -.old)
%_ $
-.old %1
::
cards
:_ cards
[%pass / %agent [our dap]:bowl %poke noun+!>(%rewatch-dms)]
==
:_ this(state old)
=. cards (flop cards)
%+ welp
?: (~(has by wex.bowl) [/graph our.bowl %graph-store])
~
~[watch-graph:ha]
cards
[watch-graph:ha cards]
%+ turn
^- (list mark)
:~ %graph-validator-chat
@ -103,9 +121,23 @@
?+ mark (on-poke:def mark vase)
%hark-graph-hook-action
(hark-graph-hook-action !<(action:hook vase))
%noun
(poke-noun !<(* vase))
==
[cards this]
::
++ poke-noun
|= non=*
?> ?=(%rewatch-dms non)
=/ graphs=(list resource)
~(tap in get-keys:gra)
:- ~
%_ state
watching
%- ~(gas in watching)
(murn graphs |=(rid=resource ?:((should-watch:ha rid) `[rid ~] ~)))
==
::
++ hark-graph-hook-action
|= =action:hook
^- (quip card _state)
@ -223,23 +255,14 @@
++ add-graph
|= rid=resource
^- (quip card _state)
=/ group-rid=(unit resource)
(group-from-app-resource:met %graph rid)
?~ group-rid
~& no-group+rid
`state
=/ is-hidden=?
!(is-managed:grp u.group-rid)
=/ should-watch
|(is-hidden &(watch-on-self =(our.bowl entity.rid)))
?. should-watch
`state
=/ graph=graph:graph-store :: graph in subscription is bunted
(get-graph-mop:gra rid)
=/ node=(unit node:graph-store)
(bind (peek:orm:graph-store graph) |=([@ =node:graph-store] node))
=^ cards state
(check-nodes (drop node) rid)
?. (should-watch:ha rid)
[cards state]
:_ state(watching (~(put in watching) [rid ~]))
(weld cards (give:ha ~[/updates] %listen [rid ~]))
::
@ -249,14 +272,14 @@
rid=resource
==
=/ group=(unit resource)
(group-from-app-resource:met %graph rid)
(peek-group:met %graph rid)
?~ group
~& no-group+rid
`state
=/ metadata=(unit metadata:metadata-store)
(peek-metadata:met %graph u.group rid)
?~ metadata `state
abet:check:(abed:handle-update:ha rid nodes u.group module.u.metadata)
=/ metadatum=(unit metadatum:metadata)
(peek-metadatum:met %graph rid)
?~ metadatum `state
abet:check:(abed:handle-update:ha rid nodes u.group module.u.metadatum)
--
::
++ on-peek on-peek:def
@ -277,6 +300,9 @@
--
::
|_ =bowl:gall
+* met ~(. mdl bowl)
grp ~(. grouplib bowl)
gra ~(. graph bowl)
::
++ get-conversion
|= rid=resource
@ -314,6 +340,16 @@
%.y
$(contents t.contents)
::
++ should-watch
|= rid=resource
^- ?
=/ group-rid=(unit resource)
(peek-group:met %graph rid)
?~ group-rid %.n
?| !(is-managed:grp u.group-rid)
&(watch-on-self =(our.bowl entity.rid))
==
::
++ handle-update
|_ $: rid=resource :: input
updates=(list node:graph-store)

10
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
@ -115,7 +115,7 @@
::
%metadata-update
=^ cards state
(metadata-update !<(metadata-update:metadata-store q.cage.sign))
(metadata-update !<(update:metadata q.cage.sign))
[cards this]
==
==
@ -140,7 +140,7 @@
:: - We have no way of retrieving old metadata to e.g. get a
:: channel's old name when it is renamed
++ metadata-update
|= update=metadata-update:metadata-store
|= =update:metadata
^- (quip card _state)
[~ state]
::

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

@ -22,6 +22,7 @@
state:state-one:store
state-2
state-3
state-4
==
+$ unread-stats
[indices=(set index:graph-store) last=@da]
@ -37,19 +38,22 @@
==
::
+$ state-2
[%2 base-state]
[%2 state-two:store]
::
+$ state-3
[%3 base-state]
[%3 state-two:store]
::
+$ state-4
[%4 base-state]
::
+$ inflated-state
$: state-3
$: state-4
cache
==
:: $cache: useful to have precalculated, but can be derived from state
:: albeit expensively
+$ cache
$: by-index=(jug stats-index:store @da)
$: by-index=(jug stats-index:store [time=@da =index:store])
~
==
::
@ -84,9 +88,16 @@
=| cards=(list card)
|^
?- -.old
%3
%4
:- (flop cards)
this(-.state old, +.state (inflate-cache:ha old))
::
%3
%_ $
-.old %4
notifications.old (convert-notifications-3 notifications.old)
archive.old (convert-notifications-3 archive.old)
==
::
%2
%_ $
@ -96,7 +107,6 @@
:_ cards
[%pass / %agent [our dap]:bowl %poke noun+!>(%fix-dangling)]
==
::
%1
%_ $
@ -125,7 +135,55 @@
==
==
==
:: discard publish edits
::
++ convert-notifications-3
|= old=notifications:state-two:store
%+ gas:orm *notifications:store
^- (list [@da timebox:store])
%+ murn
(tap:orm:state-two:store old)
|= [time=@da =timebox:state-two:store]
^- (unit [@da timebox:store])
=/ new-timebox=timebox:store
(convert-timebox-3 timebox)
?: =(0 ~(wyt by new-timebox))
~
`[time new-timebox]
::
++ convert-timebox-3
|= =timebox:state-two:store
^- timebox:store
%- ~(gas by *timebox:store)
^- (list [index:store notification:store])
%+ murn
~(tap by timebox)
|= [=index:store =notification:state-two:store]
^- (unit [index:store notification:store])
=/ new-notification=(unit notification:store)
(convert-notification-3 notification)
?~ new-notification ~
`[index u.new-notification]
::
++ convert-notification-3
|= =notification:state-two:store
^- (unit notification:store)
?: ?=(%graph -.contents.notification)
`notification
=/ con=(list group-contents:store)
(convert-group-contents-3 list.contents.notification)
?: =(~ con) ~
=, notification
`[date read %group con]
::
++ convert-group-contents-3
|= con=(list group-contents:state-two:store)
^- (list group-contents:store)
%+ murn con
|= =group-contents:state-two:store
^- (unit group-contents:store)
?. ?=(?(%add-members %remove-members) -.group-contents) ~
`group-contents
::
++ uni-by
|= [a=(set index:graph-store) b=(set index:graph-store)]
=/ merged
@ -149,13 +207,13 @@
::
++ convert-notifications-1
|= old=notifications:state-zero:store
%+ gas:orm *notifications:store
^- (list [@da timebox:store])
%+ gas:orm:state-two:store *notifications:state-two:store
^- (list [@da timebox:state-two:store])
%+ murn
(tap:orm:state-zero:store old)
|= [time=@da =timebox:state-zero:store]
^- (unit [@da timebox:store])
=/ new-timebox=timebox:store
^- (unit [@da timebox:state-two:store])
=/ new-timebox=timebox:state-two:store
(convert-timebox-1 timebox)
?: =(0 ~(wyt by new-timebox))
~
@ -163,21 +221,20 @@
::
++ convert-timebox-1
|= =timebox:state-zero:store
^- timebox:store
%- ~(gas by *timebox:store)
^- (list [index:store notification:store])
^- timebox:state-two:store
%- ~(gas by *timebox:state-two:store)
^- (list [index:store notification:state-two:store])
%+ murn
~(tap by timebox)
|= [=index:state-zero:store =notification:state-zero:store]
^- (unit [index:store notification:store])
^- (unit [index:store notification:state-two:store])
=/ new-index=(unit index:store)
(convert-index-1 index)
=/ new-notification=(unit notification:store)
=/ new-notification=(unit notification:state-two:store)
(convert-notification-1 notification)
?~ new-index ~
?~ new-notification ~
`[u.new-index u.new-notification]
::
++ convert-index-1
|= =index:state-zero:store
@ -192,7 +249,7 @@
::
++ convert-notification-1
|= =notification:state-zero:store
^- (unit notification:store)
^- (unit notification:state-two:store)
?: ?=(%chat -.contents.notification)
~
`notification
@ -228,6 +285,7 @@
[%count count]
(~(gut by last-seen) stats-index *time)
==
::
++ give-each-unreads
^- (list [stats-index:store stats:store])
%+ turn
@ -358,7 +416,7 @@
::
++ translate
^+ poke-core
?+ -.in poke-core
?- -.in
::
%add-note (add-note +.in)
%archive (do-archive +.in)
@ -376,6 +434,8 @@
%remove-graph (remove-graph +.in)
%set-dnd (set-dnd +.in)
%seen seen
%read-all read-all
::
==
::
:: +| %note
@ -447,6 +507,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
@ -477,19 +538,16 @@
::
++ read-index-each
|= [=stats-index:store ref=index:graph-store]
%+ read-index stats-index
%- read-indices
%+ skim
~(tap ^in (~(get ju by-index) stats-index))
|= time=@da
|= [time=@da =index:store]
=/ =timebox:store
(gut-orm notifications time)
%+ roll
~(tap ^in timebox)
|= [[=index:store not=notification:store] out=?]
?: out out
?. (stats-index-is-index:store stats-index index) out
?. ?=(%graph -.index) out
?. ?=(%graph -.contents.not) out
=/ not=notification:store
(~(got by timebox) index)
?. ?=(%graph -.index) %.n
?. ?=(%graph -.contents.not) %.n
(lien list.contents.not |=(p=post:post =(index.p ref)))
::
++ read-each
@ -517,35 +575,18 @@
++ read-count
|= =stats-index:store
=. unreads-count (~(put by unreads-count) stats-index 0)
=/ times=(list @da)
=/ times=(list [@da index:store])
~(tap ^in (~(get ju by-index) stats-index))
(give:(read-index stats-index times) %read-count stats-index)
(give:(read-indices times) %read-count stats-index)
::
++ read-index
|= [=stats-index:store times=(list @da)]
++ read-indices
|= times=(list [time=@da =index:store])
|-
?~ times poke-core
=/ core
(read-stats-index i.times stats-index)
(read-note i.times)
$(poke-core core, times t.times)
::
++ read-stats-index
|= [time=@da =stats-index:store]
=/ keys
~(tap ^in ~(key by (gut-orm notifications time)))
|- ^+ poke-core
?~ keys
poke-core
?. (stats-index-is-index:store stats-index i.keys)
$(keys t.keys)
=/ =notification:store
(~(got by (gut-orm notifications time)) i.keys)
?: read.notification
$(keys t.keys)
=/ core
(read-note time i.keys)
$(poke-core core, keys t.keys)
::
++ seen-index
|= [time=@da =stats-index:store]
=/ new-time=@da
@ -570,7 +611,7 @@
=. last-seen
((dif-map-by-key ,@da) last-seen indices)
=. by-index
((dif-map-by-key ,(set @da)) by-index indices)
((dif-map-by-key ,(set [@da =index:store])) by-index indices)
poke-core
::
++ get-stats-indices
@ -603,10 +644,10 @@
~(tap ^in set)
|-
?~ indices poke-core
=/ times=(list @da)
=/ times=(list [time=@da =index:store])
~(tap ^in (~(get ju by-index) i.indices))
=. poke-core
(read-index i.indices times)
(read-indices times)
$(indices t.indices)
--
::
@ -615,6 +656,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)
@ -694,14 +742,14 @@
%_ +.state
::
by-index
%. [(to-stats-index:store index) time]
%. [(to-stats-index:store index) time index]
?: read
~(del ju by-index)
~(put ju by-index)
==
::
++ inflate-cache
|= state-3
|= state-4
^+ +.state
=/ nots=(list [p=@da =timebox:store])
(tap:orm notifications)

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

BIN
pkg/arvo/app/landscape/fonts/sourcecodeprop-bold.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.6056641fbc32a19ee0fd.js"></script>
<script src="/~landscape/js/bundle/index.ee4aea08fefb9c47dcfd.js"></script>
</body>
</html>

22
pkg/arvo/app/landscape/js/channel.js
View File

@ -63,7 +63,7 @@ class Channel {
}
resetDebounceTimer() {
if(this.debounceTimer) {
if (this.debounceTimer) {
clearTimeout(this.debounceTimer);
this.debounceTimer = null;
}
@ -182,19 +182,19 @@ class Channel {
// sends a JSON command command to the server.
//
sendJSONToChannel(j) {
if(!j && this.outstandingJSON.length === 0) {
return;
}
let req = new XMLHttpRequest();
req.open("PUT", this.channelURL());
req.setRequestHeader("Content-Type", "application/json");
if (this.lastEventId == this.lastAcknowledgedEventId) {
if(j) {
if (j) {
this.outstandingJSON.push(j);
}
let x = JSON.stringify(this.outstandingJSON);
req.send(x);
if (this.outstandingJSON.length > 0) {
let x = JSON.stringify(this.outstandingJSON);
req.send(x);
}
} else {
// we add an acknowledgment to clear the server side queue
//
@ -203,15 +203,15 @@ class Channel {
//
let payload = [
...this.outstandingJSON,
{action: "ack", "event-id": parseInt(this.lastEventId)}
{action: "ack", "event-id": this.lastEventId}
];
if(j) {
if (j) {
payload.push(j)
}
let x = JSON.stringify(payload);
req.send(x);
this.lastEventId = this.lastAcknowledgedEventId;
this.lastAcknowledgedEventId = this.lastEventId;
}
this.outstandingJSON = [];
@ -227,7 +227,7 @@ class Channel {
this.eventSource = new EventSource(this.channelURL(), {withCredentials:true});
this.eventSource.onmessage = e => {
this.lastEventId = e.lastEventId;
this.lastEventId = parseInt(e.lastEventId, 10);
let obj = JSON.parse(e.data);
let pokeFuncs = this.outstandingPokes.get(obj.id);

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

@ -25,12 +25,9 @@
^- (list @tas)
:~ %group-store
%metadata-store
%metadata-hook
%contact-store
%contact-hook
%invite-store
%chat-store
%chat-hook
%graph-store
==
|= app=@tas

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

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

@ -0,0 +1,266 @@
:: metadata-pull-hook [landscape]:
::
:: allow syncing group data from foreign paths to local paths
::
/- *group, invite-store, metadata=metadata-store, contact=contact-store
/+ default-agent, verb, dbug, store=group-store, grpl=group, pull-hook
/+ resource, mdl=metadata, agn=agentio
~% %group-hook-top ..part ~
|%
+$ card card:agent:gall
::
++ config
^- config:pull-hook
:* %metadata-store
update:metadata
%metadata-update
%metadata-push-hook
%.n
==
+$ state-zero
[%0 previews=(map resource group-preview:metadata)]
::
+$ 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 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 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
!> ^- update:metadata
[%remove resource md-resource]
::
++ on-pull-kick
|= =resource
^- (unit path)
`/
--

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

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

496
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)
(poke-metadata-update:mc !<(update:store vase))
::
%import
(poke-import:mc q.vase)
::
%noun ~& +.state `state
==
[cards this]
::
@ -136,7 +150,7 @@
~
::
[%app-name @ ~]
=/ =app-name i.t.path
=/ =app-name:store i.t.path
=/ app-indices (metadata-for-app:mc app-name)
(give %metadata-update !>([%associations app-indices]))
==
@ -157,25 +171,26 @@
[%y %resource-indices ~] ``noun+!>(resource-indices)
[%x %associations ~] ``noun+!>(associations)
[%x %app-name @ ~]
=/ =app-name i.t.t.path
=/ =app-name:store i.t.t.path
``noun+!>((metadata-for-app:mc app-name))
::
[%x %group *]
=/ =group-path t.t.path
``noun+!>((metadata-for-group:mc group-path))
=/ group=resource (de-path:resource t.t.path)
``noun+!>((metadata-for-group:mc group))
::
[%x %metadata @ @ @ ~]
=/ =group-path (stab (slav %t i.t.t.path))
=/ =md-resource [`term`i.t.t.t.path (stab (slav %t i.t.t.t.t.path))]
``noun+!>((~(get by associations) [group-path md-resource]))
[%x %metadata @ @ @ @ ~]
=/ =md-resource:store
[i.t.t.path (de-path:resource t.t.t.path)]
``noun+!>((~(get by associations) md-resource))
::
[%x %resource @ *]
=/ app=term i.t.t.path
=/ app-path=^path t.t.t.path
``noun+!>((~(get by resource-indices) app app-path))
=/ rid=resource (de-path:resource t.t.t.path)
``noun+!>((~(get by resource-indices) [app rid]))
::
[%x %export ~]
``noun+!>(state)
``noun+!>(-.state)
==
::
++ on-leave on-leave:def
@ -192,307 +207,242 @@
=/ old !<(versioned-state vase)
=| cards=(list card)
|^
?: ?=(%6 -.old)
=/ =^associations
(migrate-app-to-graph-store %chat associations.old)
=* loop $
?: ?=(%7 -.old)
:- cards
%_ state
associations associations
::
resource-indices
(rebuild-resource-indices associations)
%_ state
associations
associations.old
::
resource-indices
(rebuild-resource-indices associations.old)
::
group-indices
(rebuild-group-indices associations.old)
::
app-indices
(rebuild-app-indices associations)
::
group-indices
(rebuild-group-indices associations)
(rebuild-app-indices associations.old)
==
?: ?=(%6 -.old)
=/ old-assoc=associations-1
(migrate-app-to-graph-store %chat associations.old)
$(old [%7 (associations-1-to-2 old-assoc) ~])
::
?: ?=(%5 -.old)
=/ =^associations
=/ associations=associations-1
(migrate-app-to-graph-store %publish associations.old)
%_ $
-.old %6
associations.old associations
::
resource-indices.old
(rebuild-resource-indices associations)
::
app-indices.old
(rebuild-app-indices associations)
::
group-indices.old
(rebuild-group-indices associations)
==
?: ?=(%4 -.old)
%_ $
-.old %5
::
resource-indices.old
(rebuild-resource-indices associations.old)
::
app-indices.old
(rebuild-app-indices associations.old)
::
group-indices.old
(rebuild-group-indices associations.old)
:: pre-breach, can safely throw away
loop(old *state-7)
::
++ associations-1-to-2
|= assoc=associations-1
^- associations:store
%- ~(gas by *associations:store)
%+ murn
~(tap by assoc)
|= [[group=path m=md-resource-1] met=metadata-1]
%+ biff (de-path-soft:resource group)
|= g=resource
%+ bind (md-resource-1-to-2 m)
|= =md-resource:store
[md-resource g (metadata-1-to-2 met)]
::
++ md-resource-1-to-2
|= m=md-resource-1
^- (unit md-resource:store)
%+ bind (de-path-soft:resource path.m)
|= rid=resource
:_ rid
?: =(%contacts app-name.m) %groups
app-name.m
::
++ metadata-1-to-2
|= m=metadata-1
%* . *metadatum:store
title title.m
description description.m
color color.m
date-created date-created.m
creator creator.m
module module.m
preview %.n
==
?: ?=(%3 -.old)
$(old [%4 +.old])
?: ?=(%2 -.old)
=/ new-state=state-3
%* . *state-3
associations
%- malt
%+ murn ~(tap by associations.old)
|= [[=group-path =md-resource] m=metadata-0]
^- (unit [[^group-path ^md-resource] metadata])
?: =(app-name.md-resource %link) ~
`[[group-path md-resource] (old-md-to-new m)]
==
$(old new-state)
?: ?=(%1 -.old)
%_ $
old [%2 +.old]
::
cards
%+ murn ~(tap in ~(key by group-indices.old))
|= =group-path
^- (unit card)
=/ rid (de-path-soft:resource group-path)
?~ rid ~
?: =(our.bowl entity.u.rid)
`(poke-md-hook %add-owned group-path)
`(poke-md-hook %add-synced entity.u.rid group-path)
==
=/ new-state-1=state-1
%* . *state-1
associations (migrate-associations associations.old)
group-indices (migrate-group-indices group-indices.old)
app-indices (migrate-app-indices app-indices.old)
resource-indices (migrate-resource-indices resource-indices.old)
==
$(old new-state-1)
::
++ rebuild-resource-indices
|= =^associations
%- ~(gas ju *(jug md-resource group-path))
%+ turn ~(tap in ~(key by associations))
|= [g=group-path r=md-resource]
^- [md-resource group-path]
|= =associations:store
%- ~(gas by *(map md-resource:store resource))
%+ turn ~(tap by associations)
|= [r=md-resource:store g=resource =metadatum:store]
[r g]
::
++ rebuild-group-indices
|= =^associations
%- ~(gas ju *(jug group-path md-resource))
~(tap in ~(key by associations))
|= =associations:store
%- ~(gas ju *(jug resource md-resource:store))
%+ turn
~(tap by associations)
|= [r=md-resource:store g=resource =metadatum:store]
[g r]
::
++ rebuild-app-indices
|= =^associations
%- ~(gas ju *(jug app-name [group-path app-path]))
%+ turn ~(tap in ~(key by associations))
|= [g=group-path r=md-resource]
^- [app-name [group-path app-path]]
[app-name.r [g app-path.r]]
|= =associations:store
%- ~(gas ju *(jug app-name:store [group=resource resource]))
%+ turn ~(tap by associations)
|= [r=md-resource:store g=resource =metadatum:store]
[app-name.r g resource.r]
::
++ migrate-app-to-graph-store
|= [app=@tas =^associations]
^+ associations
|= [app=@tas associations=associations-1]
^- associations-1
%- malt
%+ turn ~(tap by associations)
|= [[=group-path =md-resource] m=metadata]
^- [[^group-path ^md-resource] metadata]
|= [[=path md-resource=md-resource-1] m=metadata-1]
^- [[^path md-resource-1] metadata-1]
?. =(app-name.md-resource app)
[[group-path md-resource] m]
=/ new-app-path=path
?. ?=([@ @ ~] app-path.md-resource)
app-path.md-resource
ship+app-path.md-resource
[[group-path [%graph new-app-path]] m(module app)]
::
++ poke-md-hook
|= act=metadata-hook-action
^- card
=/ =cage metadata-hook-action+!>(act)
[%pass / %agent [our.bowl %metadata-hook] %poke cage]
::
++ new-group-path
|= =group-path
ship+(new-app-path group-path)
::
++ new-app-path
|= =app-path
^- path
?> ?=(^ app-path)
?:(=('~' i.app-path) t.app-path app-path)
::
++ old-md-to-new
|= m=metadata-0
^- metadata
%* . *metadata
title title.m
description description.m
color color.m
date-created date-created.m
creator creator.m
module *term
==
::
++ migrate-md-resource
|= md-resource
^- md-resource
?: =(%chat app-name) [%chat (new-app-path app-path)]
?: =(%contacts app-name) [%contacts ship+app-path]
[app-name app-path]
::
++ migrate-resource-indices
|= resource-indices=(jug md-resource group-path)
^- (jug md-resource group-path)
%- malt
%+ turn ~(tap by resource-indices)
|= [=md-resource paths=(set group-path)]
:- (migrate-md-resource md-resource)
(~(run in paths) new-group-path)
::
++ migrate-app-indices
|= app-indices=(jug app-name [group-path app-path])
%- malt
%+ turn ~(tap by app-indices)
|= [app=term indices=(set [=group-path =app-path])]
:- app
%- ~(run in indices)
|= [=group-path =app-path]
:- (new-group-path group-path)
?: =(%chat app) (new-app-path app-path)
?: =(%contacts app) ship+app-path
app-path
::
++ migrate-group-indices
|= group-indices=(jug group-path md-resource)
%- malt
%+ turn ~(tap by group-indices)
|= [=group-path resources=(set md-resource)]
:- (new-group-path group-path)
%- sy
%+ turn ~(tap in resources)
migrate-md-resource
::
++ migrate-associations
|= associations=associations-0
%- malt
%+ turn ~(tap by associations)
|= [[g=group-path r=md-resource] m=metadata-0]
:_ m
[(new-group-path g) (migrate-md-resource r)]
[[path md-resource] m]
=/ new-path=^path
?. ?=([@ @ ~] path.md-resource)
path.md-resource
ship+path.md-resource
[[path [%graph new-path]] m(module app)]
--
++ poke-metadata-action
|= act=metadata-action
++ poke-metadata-update
|= upd=update:store
^- (quip card _state)
?> (team:title our.bowl src.bowl)
?- -.act
%add (handle-add group-path.act resource.act metadata.act)
%remove (handle-remove group-path.act resource.act)
?> (team:title [our src]:bowl)
?+ -.upd !!
%add (handle-add +.upd)
%remove (handle-remove +.upd)
%initial-group (handle-initial-group +.upd)
==
::
++ poke-import
|= arc=*
^- (quip card _state)
|^
(on-load !>([%5 (remake-metadata ;;(tree-metadata +.arc))]))
=^ cards state
(on-load !>([%7 (remake-metadata ;;(tree-metadata +.arc))]))
:_ state
%+ weld cards
%+ turn ~(tap in ~(key by group-indices))
|= rid=resource
%- poke-our
?: =(entity.rid our.bowl)
:- %metadata-push-hook
push-hook-action+!>([%add rid])
:- %metadata-pull-hook
pull-hook-action+!>([%add [entity .]:rid])
::
++ poke-our
|= [app=term =cage]
^- card
[%pass / %agent [our.bowl app] %poke cage]
::
+$ tree-metadata
$: associations=(tree [[group-path md-resource] metadata])
group-indices=(tree [group-path (tree md-resource)])
app-indices=(tree [app-name (tree [group-path app-path])])
resource-indices=(tree [md-resource (tree group-path)])
$: associations=(tree [md-resource:store [resource metadatum:store]])
~
==
::
++ remake-metadata
|= tm=tree-metadata
^- base-state-1
^- base-state-2
:* (remake-map associations.tm)
(remake-jug group-indices.tm)
(remake-jug app-indices.tm)
(remake-jug resource-indices.tm)
~
==
--
::
++ handle-add
|= [=group-path =md-resource =metadata]
|= [group=resource =md-resource:store =metadatum:store]
^- (quip card _state)
:- %+ send-diff app-name.md-resource
?: (~(has by resource-indices) md-resource)
[%update-metadata group-path md-resource metadata]
[%add group-path md-resource metadata]
:- %- send-diff
[%add group md-resource metadatum]
%= state
associations
(~(put by associations) [group-path md-resource] metadata)
::
group-indices
(~(put ju group-indices) group-path md-resource)
(~(put by associations) md-resource [group metadatum])
::
app-indices
%+ ~(put ju app-indices)
app-name.md-resource
[group-path app-path.md-resource]
[group resource.md-resource]
::
resource-indices
(~(put ju resource-indices) md-resource group-path)
(~(put by resource-indices) md-resource group)
::
group-indices
(~(put ju group-indices) group md-resource)
==
::
++ handle-remove
|= [=group-path =md-resource]
|= [group=resource =md-resource:store]
^- (quip card _state)
:- (send-diff app-name.md-resource [%remove group-path md-resource])
:- (send-diff [%remove group md-resource])
%= state
associations
(~(del by associations) [group-path md-resource])
::
group-indices
(~(del ju group-indices) group-path md-resource)
(~(del by associations) md-resource)
::
app-indices
%+ ~(del ju app-indices)
app-name.md-resource
[group-path app-path.md-resource]
[group resource.md-resource]
::
resource-indices
(~(del ju resource-indices) md-resource group-path)
(~(del by resource-indices) md-resource)
::
group-indices
(~(del ju group-indices) group md-resource)
==
::
++ handle-initial-group
|= [group=resource =associations:store]
=/ assocs=(list [=md-resource:store grp=resource =metadatum:store])
~(tap by associations)
:- (send-diff %initial-group group associations)
|-
?~ assocs
state
=, assocs
?> =(group grp.i)
=^ cards state
(handle-add group [md-resource metadatum]:i)
$(assocs t)
::
++ metadata-for-app
|= =app-name
^- ^associations
%- ~(gas by *^associations)
%+ turn ~(tap in (~(gut by app-indices) app-name ~))
|= [=group-path =app-path]
:- [group-path [app-name app-path]]
(~(got by associations) [group-path [app-name app-path]])
|= =app-name:store
^+ associations
%+ roll ~(tap in (~(gut by app-indices) app-name ~))
|= [[group=resource rid=resource] out=associations:store]
=/ =md-resource:store
[app-name rid]
=/ [resource =metadatum:store]
(~(got by associations) md-resource)
(~(put by out) md-resource [group metadatum])
::
++ metadata-for-group
|= =group-path
^- ^associations
%- ~(gas by *^associations)
%+ turn ~(tap in (~(gut by group-indices) group-path ~))
|= =md-resource
:- [group-path md-resource]
(~(got by associations) [group-path md-resource])
|= group=resource
=/ resources=(set md-resource:store)
(~(get ju group-indices) group)
%+ roll
~(tap in resources)
|= [=md-resource:store out=associations:store]
=/ [resource =metadatum:store]
(~(got by associations) md-resource)
(~(put by out) md-resource [group metadatum])
::
++ send-diff
|= [=app-name upd=metadata-update]
|= =update:store
^- (list card)
|^
%- zing
:~ (update-subscribers /all upd)
(update-subscribers /updates upd)
(update-subscribers [%app-name app-name ~] upd)
:~ (update-subscribers /all update)
(update-subscribers /updates update)
==
::
++ update-subscribers
|= [pax=path upd=metadata-update]
|= [pax=path =update:store]
^- (list card)
[%give %fact ~[pax] %metadata-update !>(upd)]~
[%give %fact ~[pax] %metadata-update !>(update)]~
--
--

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

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

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

@ -0,0 +1,181 @@
/- *settings
/+ verb, dbug, default-agent
|%
+$ card card:agent:gall
+$ versioned-state
$% state-0
==
+$ state-0
$: %0
=settings
==
--
=| state-0
=* state -
::
%- agent:dbug
%+ verb |
^- agent:gall
=<
|_ bol=bowl:gall
+* this .
do ~(. +> bol)
def ~(. (default-agent this %|) bol)
::
++ on-init
^- (quip card _this)
`this
::
++ on-save !>(state)
::
++ on-load
|= =old=vase
^- (quip card _this)
=/ old !<(versioned-state old-vase)
?- -.old
%0 [~ this(state old)]
==
::
++ on-poke
|= [mar=mark vas=vase]
^- (quip card _this)
?> (team:title our.bol src.bol)
?. ?=(%settings-event mar)
(on-poke:def mar vas)
=/ evt=event !<(event vas)
=^ cards state
?- -.evt
%put-bucket (put-bucket:do key.evt bucket.evt)
%del-bucket (del-bucket:do key.evt)
%put-entry (put-entry:do buc.evt key.evt val.evt)
%del-entry (del-entry:do buc.evt key.evt)
==
[cards this]
::
++ on-watch
|= pax=path
^- (quip card _this)
?> (team:title our.bol src.bol)
?+ pax (on-watch:def pax)
[%all ~]
[~ this]
::
[%bucket @ ~]
=* bucket-key i.t.pax
?> (~(has by settings) bucket-key)
[~ this]
::
[%entry @ @ ~]
=* bucket-key i.t.pax
=* entry-key i.t.t.pax
=/ bucket (~(got by settings) bucket-key)
?> (~(has by bucket) entry-key)
[~ this]
==
::
++ on-peek
|= pax=path
^- (unit (unit cage))
?+ pax (on-peek:def pax)
[%x %all ~]
``settings-data+!>(all+settings)
::
[%x %bucket @ ~]
=* buc i.t.t.pax
=/ bucket=(unit bucket) (~(get by settings) buc)
?~ bucket [~ ~]
``settings-data+!>(bucket+u.bucket)
::
[%x %entry @ @ ~]
=* buc i.t.t.pax
=* key i.t.t.t.pax
=/ =bucket (fall (~(get by settings) buc) ~)
=/ entry=(unit val) (~(get by bucket) key)
?~ entry [~ ~]
``settings-data+!>(entry+u.entry)
::
[%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)

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]

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

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

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

25
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
@ -104,4 +125,8 @@
index (snoc index atom)
nodes (tap:orm:store p.children.node)
==
::
++ get-mark
|= res=resource
(scry-for ,(unit mark) /graph-mark/(scot %p entity.res)/[name.res])
--

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

7
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
==
--
::
@ -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

119
pkg/arvo/lib/metadata-json.hoon
View File

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

172
pkg/arvo/lib/metadata-store.hoon Normal file
View File

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

113
pkg/arvo/lib/metadata.hoon
View File

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

106
pkg/arvo/lib/pull-hook.hoon
View File

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

69
pkg/arvo/lib/push-hook.hoon
View File

@ -68,14 +68,14 @@
$_ ^|
|_ bowl:gall
::
:: +resource-for-update: get affected resource from an update
:: +resource-for-update: get affected resources from an update
::
:: Given a vase of the update, the mark of which is
:: update-mark.config, produce the affected resource, if any.
:: update-mark.config, produce the affected resources, if any.
::
++ resource-for-update
|~ vase
*(unit resource)
*(list resource)
::
:: +take-update: handle update from store
::
@ -155,12 +155,12 @@
=* state -
^- agent:gall
=<
|_ =bowl:gall
+* this .
og ~(. push-hook bowl)
hc ~(. +> bowl)
def ~(. (default-agent this %|) bowl)
::
++ on-init
=^ cards push-hook
on-init:og
@ -269,22 +269,33 @@
(push-updates:hc q.cage.sign)
cards
==
::
++ on-leave
|= =path
=^ cards push-hook
(on-leave:og path)
[cards this]
::
++ on-arvo
|= [=wire =sign-arvo]
=^ cards push-hook
(on-arvo:og wire sign-arvo)
[cards this]
::
++ on-fail
|= [=term =tang]
=^ cards push-hook
(on-fail:og term tang)
[cards this]
++ on-peek on-peek:og
::
++ on-peek
|= =path
^- (unit (unit cage))
?: =(/x/dbug/state path)
``noun+(slop !>(state(inner-state *vase)) on-save:og)
?. =(/x/sharing path)
(on-peek:og path)
``noun+!>(sharing)
--
|_ =bowl:gall
+* og ~(. push-hook bowl)
@ -307,6 +318,7 @@
%remove (remove +.action)
%revoke (revoke +.action)
==
::
++ add
|= rid=resource
=. sharing
@ -318,7 +330,7 @@
=/ pax=path
[%resource (en-path:resource rid)]
=/ paths=(set path)
%- sy
%- silt
%+ turn
(incoming-subscriptions pax)
|=([ship pox=path] pox)
@ -340,6 +352,7 @@
~
`[%give %kick ~[path] `her]
--
::
++ incoming-subscriptions
|= prefix=path
^- (list (pair ship path))
@ -367,32 +380,50 @@
++ push-updates
|= =vase
^- (list card:agent:gall)
=/ rid=(unit resource)
(resource-for-update:og vase)
?~ rid ~
=/ rids=(list resource) (resource-for-update vase)
=| cards=(list card:agent:gall)
|-
?~ rids cards
=/ prefix=path
resource+(en-path:resource u.rid)
resource+(en-path:resource i.rids)
=/ paths=(list path)
%~ tap in
%- silt
%+ turn
(incoming-subscriptions prefix)
|=([ship pax=path] pax)
?~ paths ~
[%give %fact paths update-mark.config vase]~
?~ paths $(rids t.rids)
%_ $
rids t.rids
cards (snoc cards [%give %fact paths update-mark.config vase])
==
::
++ forward-update
|= =vase
^- (list card:agent:gall)
=/ rid=(unit resource)
(resource-for-update:og vase)
?~ rid ~
=/ rids=(list resource) (resource-for-update vase)
=| cards=(list card:agent:gall)
|-
?~ rids cards
=/ =path
resource+(en-path:resource u.rid)
resource+(en-path:resource i.rids)
=/ =wire
(make-wire resource+(en-path:resource u.rid))
(make-wire resource+(en-path:resource i.rids))
=/ dap=term
?:(=(our.bowl entity.u.rid) store-name.config dap.bowl)
[%pass wire %agent [entity.u.rid dap] %poke update-mark.config vase]~
?:(=(our.bowl entity.i.rids) store-name.config dap.bowl)
%_ $
rids t.rids
::
cards
%+ snoc cards
[%pass wire %agent [entity.i.rids dap] %poke update-mark.config vase]
==
::
++ resource-for-update
|= =vase
^- (list resource)
%~ tap in
%- silt
(resource-for-update:og vase)
--
--

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

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

7
pkg/arvo/lib/strandio.hoon
View File

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

15
pkg/arvo/mar/contact/action.hoon
View File

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

15
pkg/arvo/mar/contact/hook-update.hoon
View File

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

16
pkg/arvo/mar/contact/initial.hoon
View File

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

15
pkg/arvo/mar/contact/share.hoon Normal file
View File

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

11
pkg/arvo/mar/contact/update.hoon
View File

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

12
pkg/arvo/mar/contact/view-action.hoon
View File

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

12
pkg/arvo/mar/graph/permissions/add.hoon Normal file
View File

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

12
pkg/arvo/mar/graph/permissions/remove.hoon Normal file
View File

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

16
pkg/arvo/mar/graph/validator/chat.hoon
View File

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

23
pkg/arvo/mar/graph/validator/link.hoon
View File

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

23
pkg/arvo/mar/graph/validator/publish.hoon
View File

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

4
pkg/arvo/mar/group/update.hoon
View File

@ -5,8 +5,8 @@
|%
++ noun upd
++ json
%+ frond:enjs:format 'groupUpdate'
(update:enjs upd)
%+ frond:enjs:format 'groupUpdate'
(update:enjs upd)
--
++ grab
|%

13
pkg/arvo/mar/group/view-action.hoon Normal file
View File

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

13
pkg/arvo/mar/group/view-update.hoon Normal file
View File

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

10
pkg/arvo/mar/metadata-hook-action.hoon Normal file
View File

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

14
pkg/arvo/mar/metadata/action.hoon
View File

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

15
pkg/arvo/mar/metadata/hook-update.hoon Normal file
View File

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

12
pkg/arvo/mar/metadata/update.hoon
View File

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

9
pkg/arvo/mar/pull-hook/action.hoon
View File

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

16
pkg/arvo/mar/resource.hoon Normal file
View File

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

13
pkg/arvo/mar/settings/data.hoon Normal file
View File

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

16
pkg/arvo/mar/settings/event.hoon Normal file
View File

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

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

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

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

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

18
pkg/arvo/sur/contact-hook.hoon
View File

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

53
pkg/arvo/sur/contact-store.hoon
View File

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

27
pkg/arvo/sur/contact-view.hoon
View File

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

21
pkg/arvo/sur/file-server.hoon
View File

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

17
pkg/arvo/sur/graph-store.hoon
View File

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

19
pkg/arvo/sur/group-store.hoon
View File

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

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