Merge remote-tracking branch 'origin/release/next-userspace' into lf/app-sane

This commit is contained in:
Liam Fitzgerald 2021-01-12 14:29:22 +10:00
commit 2cd5e462b0
No known key found for this signature in database
GPG Key ID: D390E12C61D1CFFB
318 changed files with 20491 additions and 15549 deletions

4
.github/actions/glob/Dockerfile vendored Normal file
View File

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

25
.github/actions/glob/action.yml vendored Normal file
View File

@ -0,0 +1,25 @@
name: 'glob'
description: 'Create a glob and deploy it to a moon'
inputs:
ship:
description: "Ship to deploy to"
required: true
credentials:
description: "base64-encoded GCP Service Account credentials"
required: true
ssh-sec-key:
description: "A base64-encoded SSH secret key for the container to use"
required: true
ssh-pub-key:
description: "The corresponding base64-encoded SSH public key"
required: true
runs:
using: 'docker'
image: 'Dockerfile'
args:
- ${{ inputs.ship }}
- ${{ inputs.credentials }}
- ${{ inputs.ssh-sec-key }}
- ${{ inputs.ssh-pub-key }}

38
.github/actions/glob/entrypoint.sh vendored Executable file
View File

@ -0,0 +1,38 @@
#!/usr/bin/env bash
cd "$GITHUB_WORKSPACE" || exit
echo "$2" | base64 -d > service-account
echo "$3" | base64 -d > id_ssh
echo "$4" | base64 -d > id_ssh.pub
chmod 600 service-account
chmod 600 id_ssh
chmod 600 id_ssh.pub
LANDSCAPE_STREAM="development"
export LANDSCAPE_STREAM
LANDSCAPE_SHORTHASH="${GITHUB_SHA:0:7}"
export LANDSCAPE_SHORTHASH
janeway release glob --no-pill \
--credentials service-account \
--ssh-key id_ssh \
--do-it-live \
| bash
SHORTHASH=$(git rev-parse --short HEAD)
janeway release prepare-ota arvo-glob-"$SHORTHASH" "$1" \
--credentials service-account \
--ssh-key id_ssh \
--do-it-live \
| bash
janeway release perform-ota "$1" \
--credentials service-account \
--ssh-key id_ssh \
--do-it-live \
| bash

View File

@ -50,7 +50,7 @@ jobs:
- uses: cachix/install-nix-action@v12
- uses: cachix/cachix-action@v8
with:
name: mars
name: ares
authToken: ${{ secrets.CACHIX_AUTH_TOKEN }}
- run: nix-build -A urbit --arg enableStatic true
@ -73,7 +73,7 @@ jobs:
- uses: cachix/install-nix-action@v12
- uses: cachix/cachix-action@v8
with:
name: mars
name: ares
authToken: ${{ secrets.CACHIX_AUTH_TOKEN }}
- run: nix-build -A hs.urbit-king.components.exes.urbit-king --arg enableStatic true

23
.github/workflows/glob.yml vendored Normal file
View File

@ -0,0 +1,23 @@
name: glob
on:
push:
branches:
- 'release/next-js'
pull_request:
branches:
- 'release/next-js'
jobs:
glob:
runs-on: ubuntu-latest
name: "Create and deploy a glob to ~lomlyx-lopsem-nidsut-tomdun"
steps:
- uses: actions/checkout@v2
with:
lfs: true
- uses: ./.github/actions/glob
with:
ship: 'lomlyx-lopsem-nidsut-tomdun'
credentials: ${{ secrets.JANEWAY_SERVICE_KEY }}
ssh-sec-key: ${{ secrets.JANEWAY_SSH_SEC_KEY }}
ssh-pub-key: ${{ secrets.JANEWAY_SSH_PUB_KEY }}

View File

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

View File

@ -268,6 +268,13 @@ Contributions:
[..]
```
Ensure the Vere release is marked as the 'latest' release and upload the two
`.tgz` files to the release as `darwin.tgz` and `linux64.tgz`;
this allows us to programmatically retrieve the latest release at
[urbit.org/install/mac/latest/](https://urbit.org/install/mac/latest) and
[urbit.org/install/linux64/latest](https://urbit.org/install/linux64/latest),
respectively.
The same schpeel re: release candidates applies here.
Note that the release notes indicate which version of Urbit OS the Vere release

View File

@ -4,7 +4,7 @@ build:
nix-build -A urbit -A herb --no-out-link
install:
nix-env -f . -iA urbit -iA urbit-debug -iA herb
nix-env -f . -iA urbit -iA herb
release:
sh/release

View File

@ -36,7 +36,10 @@ If you're interested in Urbit development, keep reading.
## Development
[![Build Status](https://travis-ci.org/urbit/urbit.svg?branch=master)][trav]
[![License][license-badge]][license]
[![Build][build-badge]][build]
[![Nix][nix-badge]][nix]
[![Cachix][cachix-badge]][cachix]
Urbit uses [Nix][nix] to manage builds. On Linux and macOS you can install Nix
via:
@ -45,6 +48,16 @@ via:
curl -L https://nixos.org/nix/install | sh
```
You can optionally setup Nix to pull build artefacts from the binary cache
that continuous integration uses. This will improve build times and avoid
unnecessary recompilations of common dependencies. Once Nix has been installed
you can setup Cachix via:
```
nix-env -iA cachix -f https://cachix.org/api/v1/install
cachix use ares
```
The Makefile in the project's root directory contains useful phony targets for
building, installing, testing, and so on. You can use it to avoid dealing with
Nix explicitly.
@ -69,8 +82,14 @@ git lfs install
git lfs pull
```
[trav]: https://github.com/urbit/urbit.git
[nix]: https://nixos.org/nix/
[license]: https://raw.githubusercontent.com/urbit/urbit/master/LICENSE.txt
[license-badge]: https://img.shields.io/badge/license-MIT-blue.svg
[build]: https://github.com/urbit/urbit/actions
[build-badge]: https://github.com/urbit/urbit/workflows/build/badge.svg
[cachix]: https://ares.cachix.org
[cachix-badge]: https://img.shields.io/badge/cachix-ares-purple.svg
[nix]: https://nixos.org
[nix-badge]: https://img.shields.io/badge/builtwith-nix-purple.svg
[git-lfs]: https://git-lfs.github.com
## Contributing
@ -85,4 +104,4 @@ You might also be interested in joining the [urbit-dev][list] mailing list.
[list]: https://groups.google.com/a/urbit.org/forum/#!forum/dev
[cont]: https://github.com/urbit/urbit/blob/master/CONTRIBUTING.md
[lcont]: https://github.com/urbit/urbit/blob/master/pkg/interface/CONTRIBUTING.md
[lcont]: https://github.com/urbit/urbit/blob/master/pkg/interface/CONTRIBUTING.md

View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1
oid sha256:1e3ad5f88585ef7938cc2c6b5e37a05e04b7a4e5a9d66f1e9e4c20bfa2d303e8
size 5356007
oid sha256:61e583dd7db795dac4a7c31bfd3ee8b240e679bb882e35d4e7d1acb5f9f2f3d6
size 8270131

View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1
oid sha256:1ddcdd98af2befa672da7bbf74ba5170cd5b079f2fb75deb24685608da6a29c8
size 2841752
oid sha256:185ea5e76dc48695e55efc543377e0682e485f81b16e3b443f9be881d026d4f2
size 2616564

View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1
oid sha256:ae42d143088198dea06be473b43450c1478c094e19f69e79305e63da1c49a832
size 9581384
oid sha256:17eb2f5a123f5ad29b0cc9ff9069540c349dd97c6133a9ea33cbf81e0bfa4d6b
size 8483784

View File

@ -11,7 +11,7 @@
Note that on linux the previous command is equivalent to:
$ nix-build -A urbit --argstr crossSystem x86_64-unknown-linux-musl \
--arg enableSatic true
--arg enableStatic true
Static urbit-king binary:
@ -153,7 +153,8 @@ let
contents = {
"${name}/urbit" = "${urbit}/bin/urbit";
"${name}/urbit-worker" = "${urbit}/bin/urbit-worker";
"${name}/urbit-king" = "${urbit-king}/bin/urbit-king";
# temporarily removed for compatibility reasons
# "${name}/urbit-king" = "${urbit-king}/bin/urbit-king";
};
};

View File

@ -28,7 +28,6 @@ done
# FIXME: reduce this list
cp $ARVO/app/lens.hoon ./pier/home/app/
cp $ARVO/app/dojo.hoon ./pier/home/app/
cp $ARVO/lib/base64.hoon ./pier/home/lib/
cp $ARVO/lib/plume.hoon ./pier/home/lib/
cp $ARVO/lib/server.hoon ./pier/home/lib/
cp $ARVO/lib/sole.hoon ./pier/home/lib/

View File

@ -1,5 +1,5 @@
/- asn1
/+ base64, der, primitive-rsa, *pkcs, *jose, default-agent, verb
/+ der, primitive-rsa, *pkcs, *jose, default-agent, verb
=, eyre
=* rsa primitive-rsa
::
@ -7,11 +7,11 @@
:: +en-base64url: url-safe base64 encoding, without padding
::
++ en-base64url
~(en base64 | &)
~(en base64:mimes:html | &)
:: +de-base64url: url-safe base64 decoding, without padding
::
++ de-base64url
~(de base64 | &)
~(de base64:mimes:html | &)
:: +join-turf
::
++ join-turf

View File

@ -21,30 +21,28 @@
:: We get ++unix-event and ++pill from /-aquarium
::
/- aquarium
/+ pill, default-agent, aqua-azimuth, dbug, verb
/+ pill, azimuth, default-agent, aqua-azimuth, dbug, verb
=, pill-lib=pill
=, aquarium
=> $~ |%
+$ versioned-state
$% state-0
state-1
==
+$ state-0
$: %0
pil=pill
assembled=*
tym=@da
fleet-snaps=(map term (map ship pier))
piers=(map ship pier)
==
+$ state-1
$: %1
pil=pill
assembled=*
tym=@da
fleet-snaps=(map term fleet)
piers=fleet
==
:: XX temporarily shadowed, fix and remove
::
+$ pill
$: boot-ova=*
kernel-ova=(list unix-event)
userspace-ova=(list unix-event)
==
::
+$ fleet [ships=(map ship pier) azi=az-state]
+$ pier
@ -55,7 +53,7 @@
==
--
::
=| state-1
=| state-0
=* state -
=<
%- agent:dbug
@ -79,13 +77,6 @@
:: wipe fleets and piers rather than give them falsely nulled azimuth state
::
%0
%_ $
-.old %1
fleet-snaps.old *(map term fleet)
piers.old *fleet
==
::
%1
[cards this(state old)]
==
::
@ -520,7 +511,7 @@
:: should be deleted now that aqua is capable of managing azimuth state
:: internally. Its been left this way for now until all the ph tests
:: can be rewritten
=/ keys=dawn-event:able:jael (dawn who.ae)
=/ keys=dawn-event:jael (dawn who.ae)
=. this abet-pe:(publish-effect:(pe who.ae) [/ %sleep ~])
=/ initted
=< plow
@ -736,7 +727,7 @@
::
++ dawn
|= who=ship
^- dawn-event:able:jael
^- dawn-event:jael
?> ?=(?(%czar %king %duke) (clan:title who))
=/ spon=(list [ship point:azimuth])
%- flop
@ -759,7 +750,7 @@
?: ?=(%czar (clan:title ship))
[a-point]~
[a-point $(who ship)]
=/ =seed:able:jael
=/ =seed:jael
=/ life-rift (~(got by lives.azi.piers) who)
=/ =life lyfe.life-rift
[who life sec:ex:(get-keys:aqua-azimuth who life) ~]

View File

@ -1,6 +1,6 @@
/- eth-watcher
/+ default-agent, verb
=, able:jael
/+ ethereum, azimuth, default-agent, verb
=, jael
|%
++ app-state
$: %0

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@ -2,8 +2,10 @@
::
:: data store that holds linear sequences of chat messages
::
/+ store=chat-store, default-agent, verb, dbug, group-store, *migrate
~% %chat-store-top ..is ~
/- *group, store=chat-store
/+ default-agent, verb, dbug, group-store,
graph-store, resource, *migrate, grpl=group, mdl=metadata
~% %chat-store-top ..part ~
|%
+$ card card:agent:gall
+$ versioned-state
@ -11,18 +13,21 @@
state-1
state-2
state-3
state-4
==
::
+$ state-0 [%0 =inbox:store]
+$ state-1 [%1 =inbox:store]
+$ state-2 [%2 =inbox:store]
+$ state-3 [%3 =inbox:store]
+$ state-4 [%4 =inbox:store]
+$ admin-action
$% [%trim ~]
[%migrate-graph ~]
==
--
::
=| state-3
=| state-4
=* state -
::
%- agent:dbug
@ -47,7 +52,11 @@
|-
^- (quip card _this)
?- -.old
%3 [cards this(state old)]
%4 [cards this(state old)]
::
%3
=. cards :_(cards (poke-admin %migrate-graph ~))
$(old [%4 inbox.old])
::
%2
=/ =inbox:store
@ -71,6 +80,10 @@
?(%0 %1) $(old (old-to-2 inbox.old))
::
==
++ poke-admin
|= =admin-action
^- card
[%pass / %agent [our dap]:bowl %poke noun+!>(admin-action)]
::
++ old-to-2
|= =inbox:store
@ -89,36 +102,12 @@
?> (team:title our.bowl src.bowl)
=^ cards state
?+ mark (on-poke:def mark vase)
%json (poke-json:cc !<(json vase))
%chat-action (poke-chat-action:cc !<(action:store vase))
%noun [~ (poke-noun:cc !<(admin-action vase))]
%noun (poke-noun:cc !<(admin-action vase))
%import (poke-import:cc q.vase)
==
[cards this]
::
++ on-watch
~/ %chat-store-watch
|= =path
^- (quip card _this)
|^
?> (team:title our.bowl src.bowl)
=/ cards=(list card)
?+ path (on-watch:def path)
[%keys ~] (give %chat-update !>([%keys ~(key by inbox)]))
[%all ~] (give %chat-update !>([%initial inbox]))
[%updates ~] ~
[%mailbox @ *]
?> (~(has by inbox) t.path)
(give %chat-update !>([%create t.path]))
==
[cards this]
::
++ give
|= =cage
^- (list card)
[%give %fact ~ cage]~
--
::
++ on-watch on-watch:def
++ on-leave on-leave:def
++ on-peek
~/ %chat-store-peek
@ -150,9 +139,10 @@
++ on-fail on-fail:def
--
::
::
~% %chat-store-library ..card ~
|_ bol=bowl:gall
++ met ~(. mdl bol)
++ grp ~(. grpl bol)
::
++ peek-x-envelopes
|= pax=path
@ -194,8 +184,12 @@
::
++ poke-noun
|= nou=admin-action
^- _state
^- (quip card _state)
?: ?=([%migrate-graph ~] nou)
:_ state
(migrate-inbox inbox)
~& %trimming-chat-store
:- ~
%_ state
inbox
%- ~(urn by inbox)
@ -218,115 +212,12 @@
[[len len] (flop out)]
==
::
++ poke-json
|= jon=json
^- (quip card _state)
(poke-chat-action (action:dejs:store jon))
::
++ poke-chat-action
|= =action:store
^- (quip card _state)
?- -.action
%create (handle-create action)
%delete (handle-delete action)
%read (handle-read action)
%messages (handle-messages action)
%message
?. =(our.bol author.envelope.action)
(handle-message action)
=^ message-moves state (handle-message action)
=^ read-moves state (handle-read [%read path.action])
[(weld message-moves read-moves) state]
==
::
++ poke-import
|= arc=*
^- (quip card _state)
=/ sty=state-3 [%3 (remake-map ;;((tree [path mailbox:store]) +.arc))]
[~ sty]
::
++ handle-create
|= =action:store
^- (quip card _state)
?> ?=(%create -.action)
?: (~(has by inbox) path.action) [~ state]
:- (send-diff path.action action)
state(inbox (~(put by inbox) path.action *mailbox:store))
::
++ handle-delete
|= =action:store
^- (quip card _state)
?> ?=(%delete -.action)
=/ mailbox=(unit mailbox:store)
(~(get by inbox) path.action)
?~ mailbox [~ state]
:- (send-diff path.action action)
state(inbox (~(del by inbox) path.action))
::
++ handle-message
|= =action:store
^- (quip card _state)
?> ?=(%message -.action)
=/ mailbox=(unit mailbox:store)
(~(get by inbox) path.action)
?~ mailbox
[~ state]
=. letter.envelope.action (evaluate-letter [author letter]:envelope.action)
=^ envelope u.mailbox (prepend-envelope u.mailbox envelope.action)
:_ state(inbox (~(put by inbox) path.action u.mailbox))
(send-diff path.action action(envelope envelope))
::
++ handle-messages
|= act=action:store
^- (quip card _state)
?> ?=(%messages -.act)
=/ mailbox=(unit mailbox:store)
(~(get by inbox) path.act)
?~ mailbox
[~ state]
=. envelopes.act (flop envelopes.act)
=| evaluated-envelopes=(list envelope:store)
|- ^- (quip card _state)
?~ envelopes.act
:_ state(inbox (~(put by inbox) path.act u.mailbox))
%+ send-diff path.act
[%messages path.act 0 (lent evaluated-envelopes) evaluated-envelopes]
=. letter.i.envelopes.act (evaluate-letter [author letter]:i.envelopes.act)
=^ envelope u.mailbox (prepend-envelope u.mailbox i.envelopes.act)
=. evaluated-envelopes [envelope evaluated-envelopes]
$(envelopes.act t.envelopes.act)
::
++ handle-read
|= act=action:store
^- (quip card _state)
?> ?=(%read -.act)
=/ mailbox=(unit mailbox:store) (~(get by inbox) path.act)
?~ mailbox
[~ state]
=. read.config.u.mailbox length.config.u.mailbox
:- (send-diff path.act act)
state(inbox (~(put by inbox) path.act u.mailbox))
::
++ evaluate-letter
|= [author=ship =letter:store]
^- letter:store
=? letter
?& ?=(%code -.letter)
?=(~ output.letter)
(team:title our.bol author)
==
=/ =hoon (ream expression.letter)
letter(output (eval:store bol hoon))
letter
::
++ prepend-envelope
|= [=mailbox:store =envelope:store]
^+ [envelope mailbox]
=. number.envelope +(length.config.mailbox)
=: length.config.mailbox +(length.config.mailbox)
envelopes.mailbox [envelope envelopes.mailbox]
==
[envelope mailbox]
=/ sty=state-4 [%4 (remake-map ;;((tree [path mailbox:store]) +.arc))]
:_ sty
(migrate-inbox inbox.sty)
::
++ update-subscribers
|= [pax=path =update:store]
@ -346,4 +237,98 @@
~
(update-subscribers /keys upd)
==
::
++ migrate-inbox
|= =inbox:store
^- (list card)
%- zing
(turn ~(tap by inbox) mailbox-to-updates)
::
++ add-graph
|= [rid=resource =mailbox:store]
%- poke-graph-store
:+ %0 now.bol
:+ %add-graph rid
:- (mailbox-to-graph mailbox)
[`%graph-validator-chat %.y]
::
++ archive-graph
|= rid=resource
%- poke-graph-store
[%0 now.bol %archive-graph rid]
::
++ nobody
^- @p
(bex 128)
::
++ path-to-resource
|= =path
^- resource
?. ?=([@ @ ~] path)
nobody^(spat path)
=/ m-ship=(unit ship)
(slaw %p i.path)
?~ m-ship
nobody^(spat path)
[u.m-ship i.t.path]
::
++ mailbox-to-updates
|= [=path =mailbox:store]
^- (list card)
=/ app-rid=resource
(path-to-resource path)
=/ group-rid=resource
(fall (group-from-app-resource:met %graph app-rid) [nobody %bad-group])
=/ group=(unit group)
(scry-group:grp group-rid)
:- (add-graph app-rid mailbox)
?~ group (archive-graph app-rid)^~
?. &(=(~ members.u.group) hidden.u.group) ~
~& >>> "archiving {<app-rid>}"
:~ (archive-graph app-rid)
(remove-group group-rid)
==
::
++ remove-group
|= group=resource
^- card
=- [%pass / %agent [our.bol %group-store] %poke -]
group-update+!>([%remove-group group ~])
::
++ poke-graph-store
|= =update:graph-store
^- card
[%pass / %agent [our.bol %graph-store] %poke %graph-update !>(update)]
::
++ letter-to-contents
|= =letter:store
^- (list content:graph-store)
:_ ~
?. ?=(%me -.letter)
letter
[%text narrative.letter]
::
++ envelope-to-node
|= =envelope:store
^- [atom:graph-store node:graph-store]
=/ contents=(list content:graph-store)
(letter-to-contents letter.envelope)
=/ =index:graph-store
[when.envelope ~]
=, envelope
:- when.envelope
:_ [%empty ~]
^- post:graph-store
:* author
index
when
contents
~ ~
==
::
++ mailbox-to-graph
|= =mailbox:store
^- graph:graph-store
%+ gas:orm:graph-store *graph:graph-store
(turn envelopes.mailbox envelope-to-node)
--

View File

@ -1,545 +1,35 @@
:: chat-view [landscape]:
:: chat-view [landscape]: deprecated
::
:: sets up chat JS client, paginates data, and combines commands
:: into semantic actions for the UI
::
/- *group,
inv=invite-store,
*metadata-store,
*chat-hook,
*metadata-hook,
hook=chat-hook,
contact-view,
pull-hook
/+ *server, default-agent, verb, dbug,
store=chat-store,
view=chat-view,
group-store,
grpl=group,
resource,
mdl=metadata
::
~% %chat-view-top ..is ~
/+ default-agent
|%
+$ versioned-state
$% state-0
==
::
+$ state-0
$: %0
~
==
+$ poke
$% [%chat-action action:store]
[%group-action action:group-store]
[%chat-hook-action action:hook]
==
::
+$ card card:agent:gall
--
::
=| state-0
=* state -
::
%+ verb |
%- agent:dbug
^- agent:gall
=<
~% %chat-view-agent-core ..poke-handle-http-request ~
|_ bol=bowl:gall
+* this .
chat-core +>
cc ~(. chat-core bol)
def ~(. (default-agent this %|) bol)
::
++ on-init
^- (quip card _this)
:_ this
:~ :* %pass /srv %agent [our.bol %file-server]
%poke %file-server-action
!>([%serve-dir /'~chat' /app/landscape %.n %.y])
==
[%pass / %arvo %e %connect [~ /'chat-view'] %chat-view]
[%pass /updates %agent [our.bol %chat-store] %watch /updates]
==
::
++ on-poke
~/ %chat-view-poke
|= [=mark =vase]
^- (quip card _this)
?> (team:title our.bol src.bol)
?+ mark (on-poke:def mark vase)
%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
::
%json
:_ this
(poke-chat-view-action:cc (action:dejs:view !<(json vase)))
::
%chat-view-action
:_ this
(poke-chat-view-action:cc !<(action:view vase))
==
::
++ on-watch
~/ %chat-view-watch
|= =path
^- (quip card _this)
?> (team:title our.bol src.bol)
|^
?: ?=([%http-response *] path)
[~ this]
?: =(/primary path)
:: create inbox with 20 messages max per mailbox and send that along
:: then quit the subscription
:_ this
[%give %fact ~ %json !>((update:enjs:store [%initial truncated-inbox]))]~
(on-watch:def path)
::
++ message-limit 20
::
++ truncated-inbox
^- inbox:store
=/ =inbox:store
=/ our (scot %p our.bol)
=/ now (scot %da now.bol)
.^(inbox:store %gx /[our]/chat-store/[now]/all/noun)
%- ~(run by inbox)
|= =mailbox:store
^- mailbox:store
[config.mailbox (scag message-limit envelopes.mailbox)]
--
::
++ on-agent
~/ %chat-view-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
?+ -.sign (on-agent:def wire sign)
%poke-ack
?. ?=([%join-group @ @ @ @ @ ~] wire)
(on-agent:def wire sign)
?^ p.sign
(on-agent:def wire sign)
=/ =ship
(slav %p i.t.wire)
=/ ask-history=?
=('y' i.t.t.wire)
=/ rid=resource
(de-path:resource t.t.t.wire)
:_ this
(joined-group:cc rid ship ask-history)
::
%kick
:_ this
[%pass / %agent [our.bol %chat-store] %watch /updates]~
::
%fact
?+ p.cage.sign (on-agent:def wire sign)
%chat-update
:_ this
(diff-chat-update:cc !<(update:store q.cage.sign))
==
==
::
++ on-arvo
~/ %chat-view-arvo
|= [=wire =sign-arvo]
^- (quip card _this)
?: ?=(%bound +<.sign-arvo) [~ this]
(on-arvo:def wire sign-arvo)
::
++ 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 [~ /'~chat']]
[%pass / %arvo %e %connect [~ /'chat-view'] %chat-view]
:* %pass /srv %agent [our.bol %file-server]
%poke %file-server-action
!>([%serve-dir /'~chat' /app/landscape %.n %.y])
==
==
::
++ on-leave on-leave:def
++ on-peek on-peek:def
++ on-fail on-fail:def
--
::
::
~% %chat-view-library ..card ~
|_ bol=bowl:gall
++ grp ~(. grpl bol)
++ md ~(. mdl bol)
+* this .
def ~(. (default-agent this %|) bol)
::
++ poke-handle-http-request
|= =inbound-request:eyre
^- simple-payload:http
=+ url=(parse-request-line url.request.inbound-request)
?+ site.url not-found:gen
[%'chat-view' %paginate @t @t *]
=/ start (need (rush i.t.t.site.url dem))
=/ end (need (rush i.t.t.t.site.url dem))
=/ pax t.t.t.t.site.url
=/ envelopes (envelope-scry [(scot %ud start) (scot %ud end) pax])
%- json-response:gen
%- update:enjs:store
[%messages pax start end envelopes]
++ on-init
^- (quip card _this)
:_ this
:~ :* %pass /srv %agent [our.bol %file-server]
%poke %file-server-action
!>([%serve-dir /'~chat' /app/landscape %.n %.y])
==
==
::
++ poke-json
|= jon=json
^- (list card)
?> (team:title our.bol src.bol)
(poke-chat-view-action (action:dejs:view jon))
++ 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-chat-view-action
|= act=action:view
^- (list card)
|^
?> (team:title our.bol src.bol)
?- -.act
%create
?> ?=(^ app-path.act)
?> ?| =(+:group-path.act app-path.act)
=(~(tap in members.act) ~)
==
?^ (chat-scry app-path.act)
~& %chat-already-exists
~
%- zing
:~ %- create-group
:* group-path.act
app-path.act
policy.act
members.act
title.act
description.act
managed.act
==
(create-metadata title.act description.act group-path.act app-path.act)
(create-chat app-path.act allow-history.act)
==
::
%delete
?> ?=(^ app-path.act)
:: always just delete the chat from chat-store
::
:+ (chat-hook-poke [%remove app-path.act])
(chat-poke [%delete app-path.act])
:: if we still have metadata for the chat, remove it, and the associated
:: group if it's unmanaged.
::
:: we aren't guaranteed to have metadata: the chat might have been
:: deleted by the host, which pushes metadata deletion down to us.
::
=/ maybe-group-path
(maybe-group-from-chat app-path.act)
?~ maybe-group-path
~
=* group-path u.maybe-group-path
=/ rid=resource
(de-path:resource group-path)
=/ maybe-group
(scry-group:grp rid)
=/ hidden
?~ maybe-group
%.n
hidden.u.maybe-group
%- zing
:~ ?. (is-creator group-path %chat app-path.act)
~
[(metadata-poke [%remove group-path [%chat app-path.act]])]~
::
?. hidden
~
:~ (group-proxy-poke %remove-members rid (sy our.bol ~))
(group-poke [%remove-group rid ~])
(metadata-hook-poke [%remove group-path])
(metadata-store-poke [%remove group-path [%chat app-path.act]])
==
==
::
%invite
=/ =group-path
(need (maybe-group-from-chat app-path.act))
=/ rid=resource
(de-path:resource group-path)
=/ =group
(need (scry-group:grp rid))
?> ?=(%invite -.policy.group)
:- (group-poke %change-policy rid %invite %add-invites ships.act)
%+ turn
~(tap in ships.act)
|= =ship
(send-invite group-path app-path.act ship)
::
%join
=/ group-path
(maybe-group-from-chat app-path.act)
=/ group
?~ group-path
~
(scry-group-path:grp u.group-path)
?: &(?=(^ group) =(hidden.u.group %.n))
~[(chat-hook-poke %add-synced ship.act app-path.act ask-history.act)]
=/ rid=resource
(de-path:resource ship+app-path.act)
?: =(our.bol entity.rid) ~
=/ =cage
:- %group-update
!> ^- action:group-store
[%add-members rid (sy our.bol ~)]
:: we need this info in the wire to continue the flow after the
:: poke ack
=/ =wire
:- %join-group
[(scot %p ship.act) ?:(ask-history.act %y %n) ship+app-path.act]
[%pass wire %agent [entity.rid %group-push-hook] %poke cage]~
::
%groupify
=* app-path app-path.act
=/ group-path
(snag 0 (groups-from-resource:md %chat app-path))
=/ scry-pax=path
/metadata/[(scot %t (spat group-path))]/chat/[(scot %t (spat app-path))]
=/ =metadata
(need (scry-for (unit metadata) %metadata-store scry-pax))
=/ old-rid=resource
(de-path:resource group-path)
?< (is-managed:grp old-rid)
?~ existing.act
:: just create contacts object for group
~[(contact-view-poke %groupify old-rid title.metadata description.metadata)]
:: change associations
=* group-path group-path.u.existing.act
=/ rid=resource
(de-path:resource group-path)
=/ old-group=group
(need (scry-group:grp old-rid))
=/ =group
(need (scry-group:grp rid))
=/ ships=(set ship)
(~(dif in members.old-group) members.group)
:* (metadata-store-poke %remove ship+app-path %chat app-path)
(metadata-store-poke %add group-path [%chat app-path] metadata)
(group-poke %remove-group old-rid ~)
?. inclusive.u.existing.act
~
:- (group-poke %add-members rid ships)
%+ turn
~(tap in ships)
|= =ship
(send-invite group-path app-path ship)
==
==
::
++ create-chat
|= [=path history=?]
^- (list card)
:~ (chat-poke [%create path])
(chat-hook-poke [%add-owned path history])
==
::
++ create-group
|= [=path app-path=path =policy ships=(set ship) title=@t desc=@t managed=?]
^- (list card)
?^ (scry-group-path:grp path) ~
=/ rid=resource
(de-path:resource path)
?> =(our.bol entity.rid)
:: do not create a contacts object if this is unmanaged
::
:-
?. managed
(group-poke %add-group rid policy %.y)
(contact-view-poke %create name.rid policy title desc)
%+ murn ~(tap in ships)
|= =ship
^- (unit card)
?: =(ship our.bol) ~
`(send-invite path app-path ship)
::
++ create-metadata
|= [title=@t description=@t group-path=path app-path=path]
^- (list card)
=/ =metadata
%* . *metadata
title title
description description
date-created now.bol
creator
(slav %p (snag 0 app-path))
==
:~ (metadata-poke [%add group-path [%chat app-path] metadata])
(metadata-hook-poke [%add-owned group-path])
==
::
++ contact-view-poke
|= act=contact-view-action:contact-view
^- card
[%pass / %agent [our.bol %contact-view] %poke %contact-view-action !>(act)]
::
++ metadata-poke
|= act=metadata-action
^- card
[%pass / %agent [our.bol %metadata-hook] %poke %metadata-action !>(act)]
::
++ metadata-store-poke
|= act=metadata-action
^- card
[%pass / %agent [our.bol %metadata-store] %poke %metadata-action !>(act)]
::
++ send-invite
|= [group-path=path app-path=path =ship]
^- card
=/ managed=?
!=(ship+app-path group-path)
=/ =invite:inv
:* our.bol
?:(managed %contact-hook %chat-hook)
(de-path:resource ?:(managed group-path ship+app-path))
ship ''
==
=/ act=action:inv
[%invite ?:(managed %contacts %chat) (shaf %msg-uid eny.bol) invite]
[%pass / %agent [our.bol %invite-hook] %poke %invite-action !>(act)]
::
++ chat-scry
|= pax=path
^- (unit mailbox:store)
=. pax
;: weld
/(scot %p our.bol)/chat-store/(scot %da now.bol)/mailbox
pax
/noun
==
.^((unit mailbox:store) %gx pax)
::
++ maybe-group-from-chat
|= app-path=path
^- (unit path)
?. .^(? %gu (scot %p our.bol) %metadata-store (scot %da now.bol) ~)
?: ?=([@ ^] app-path)
~& [%assuming-ported-legacy-chat app-path]
`[%'~' app-path]
~& [%weird-chat app-path]
!!
=/ resource-indices
.^ (jug md-resource group-path)
%gy
(scot %p our.bol)
%metadata-store
(scot %da now.bol)
/resource-indices
==
=/ groups=(set path)
%+ fall
(~(get by resource-indices) [%chat app-path])
*(set path)
?~ groups ~
`n.groups
::
++ group-from-chat
(cork maybe-group-from-chat need)
::
++ is-managed
|= =path
^- ?
?> ?=(^ path)
!=(i.path '~')
::
++ is-creator
|= [group-path=path app-name=@ta app-path=path]
^- ?
=/ meta=(unit metadata)
.^ (unit metadata)
%gx
(scot %p our.bol)
%metadata-store
(scot %da now.bol)
%metadata
(scot %t (spat group-path))
app-name
(scot %t (spat app-path))
/noun
==
?~ meta !!
=(our.bol creator.u.meta)
--
:: +joined-group: Successfully joined unmanaged group, continue flow
::
++ joined-group
|= [rid=resource =ship ask-history=?]
^- (list card)
=/ =path
(en-path:resource rid)
?> ?=(^ path)
:~ (group-pull-hook-poke %add ship rid)
(metadata-hook-poke %add-synced ship path)
(chat-hook-poke %add-synced ship t.path ask-history)
==
::
++ diff-chat-update
|= upd=update:store
^- (list card)
[%give %fact ~[/primary] %json !>((update:enjs:store upd))]~
::
:: +utilities
::
++ chat-poke
|= act=action:store
^- card
[%pass / %agent [our.bol %chat-store] %poke %chat-action !>(act)]
::
++ group-poke
|= upd=update:group-store
^- card
[%pass / %agent [our.bol %group-store] %poke %group-update !>(upd)]
++ group-pull-hook-poke
|= act=action:pull-hook
^- card
[%pass / %agent [our.bol %group-pull-hook] %poke %pull-hook-action !>(act)]
::
++ group-proxy-poke
|= act=action:group-store
^- card
[%pass / %agent [entity.resource.act %group-push-hook] %poke %group-update !>(act)]
::
++ chat-hook-poke
|= act=action:hook
^- card
[%pass / %agent [our.bol %chat-hook] %poke %chat-hook-action !>(act)]
::
++ metadata-hook-poke
|= act=metadata-hook-action
^- card
:* %pass / %agent
[our.bol %metadata-hook]
%poke %metadata-hook-action
!>(act)
==
::
++ envelope-scry
|= pax=path
^- (list envelope:store)
(scry-for (list envelope:store) %chat-store [%envelopes pax])
::
::
++ scry-for
|* [=mold app=term =path]
.^ mold
%gx
(scot %p our.bol)
app
(scot %da now.bol)
(snoc `^path`path %noun)
==
++ on-leave on-leave:def
++ on-peek on-peek:def
++ on-fail on-fail:def
--

View File

@ -1,9 +1,6 @@
:: claz: command line azimuth, for the power-user
::
/+ *claz, verb, default-agent
::
=, ethereum
=, azimuth
/+ *claz, *ethereum, *azimuth, verb, default-agent
::
|%
+$ state-0

View File

@ -15,7 +15,7 @@
resource,
grpl=group,
*migrate
~% %contact-hook-top ..is ~
~% %contact-hook-top ..part ~
|%
+$ card card:agent:gall
::
@ -197,7 +197,7 @@
=/ nack-count=@ud (slav %ud i.t.wire)
=/ who=@p (slav %p i.t.t.wire)
=/ pax t.t.t.wire
?> ?=([%b %wake *] sign-arvo)
?> ?=([%behn %wake *] sign-arvo)
~? ?=(^ error.sign-arvo)
"behn errored in backoff timers, continuing anyway"
:_ this

View File

@ -66,7 +66,7 @@
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card _this)
?. ?=([%e %bound *] sign-arvo)
?. ?=([%eyre %bound *] sign-arvo)
(on-arvo:def wire sign-arvo)
~? !accepted.sign-arvo
[dap.bowl "bind rejected!" binding.sign-arvo]

File diff suppressed because one or more lines are too long

File diff suppressed because one or more lines are too long

View File

@ -117,7 +117,7 @@
|= [our=ship dir=beam]
|%
++ default-app %hood
++ hoon-parser (vang | (en-beam:format dir))
++ hoon-parser (vang | (en-beam dir))
++ our p.dir
::
++ parse-command-line ;~(sfix parse-command (star ace) (just '\0a'))
@ -248,7 +248,7 @@
::
=? a &(?=(^ a) =('' i.a))
t.a
(fall (de-beam:format a) [`beak`[p q r]:dir a])
(fall (de-beam a) [`beak`[p q r]:dir a])
=+ vez=hoon-parser
(sear plex:vez (stag %clsg poor:vez))
::
@ -269,7 +269,7 @@
++ parse-rood
:: XX should this use +hoon-parser instead to normalize the case?
::
=> (vang | (en-beam:format dir))
=> (vang | (en-beam dir))
;~ pose
rood
::
@ -542,9 +542,9 @@
?: ?=([@ ~] pax) ~[i.pax %home '0']
?: ?=([@ @ ~] pax) ~[i.pax i.t.pax '0']
pax
=. dir (need (de-beam:format pax))
=. dir (need (de-beam pax))
=- +>(..dy (he-diff %tan - ~))
rose+[" " `~]^~[leaf+"=%" (smyt (en-beam:format he-beak s.dir))]
rose+[" " `~]^~[leaf+"=%" (smyt (en-beam he-beak s.dir))]
==
::
%poke
@ -560,7 +560,7 @@
%file
%- he-card(poy ~)
:* %pass /file %arvo %c
%info (foal:space:userlib (en-beam:format p.p.mad) cay)
%info (foal:space:userlib (en-beam p.p.mad) cay)
==
::
%flat
@ -874,12 +874,12 @@
%dv (dy-sing hand+p.bil %a (snoc p.bil %hoon))
%ge (dy-run-generator (dy-cage p.p.p.bil) q.p.bil)
%sa
=+ .^(=dais:clay cb+(en-beam:format he-beak /[p.bil]))
=+ .^(=dais:clay cb+(en-beam he-beak /[p.bil]))
(dy-hand p.bil bunt:dais)
::
%as
=/ cag=cage (dy-cage p.q.bil)
=+ .^(=tube:clay cc+(en-beam:format he-beak /[p.cag]/[p.bil]))
=+ .^(=tube:clay cc+(en-beam he-beak /[p.cag]/[p.bil]))
(dy-hand p.bil (tube q.cag))
::
%do
@ -1183,7 +1183,7 @@
%stdout [%show %0]
%output-file $(sink.com [%command (cat 3 '@' pax.sink.com)])
%output-pill $(sink.com [%command (cat 3 '.' pax.sink.com)])
%output-clay [%file (need (de-beam:format pax.sink.com))]
%output-clay [%file (need (de-beam pax.sink.com))]
%url [%http %post (crip (en-purl:html url.sink.com))]
%to-api !!
%send-api [%poke our.hid api.sink.com]
@ -1254,7 +1254,7 @@
=+ vex=((full parse-command-line:he-parser) [1 1] txt)
?. ?=([* ~ [* @ %ex *] *] vex)
(he-tab-not-hoon pos :(weld buf (tufa buf.say) "\0a"))
=/ typ p:(slop q:he-hoon-head !>(..dawn))
=/ typ p:(slop q:he-hoon-head !>(..zuse))
=/ tl (tab-list-hoon:auto typ p.q.q.p.u.q.vex)
=/ advance (advance-hoon:auto typ p.q.q.p.u.q.vex)
=? res ?=(^ advance)

View File

@ -13,7 +13,7 @@
:: waiting for confirms every 4 txs
:: :eth-sender [%send %/txs/txt 4 `index+50 ~]
::
/+ default-agent, verb
/+ ethereum, default-agent, verb
::
|%
++ state-0

View File

@ -1,9 +1,9 @@
:: eth-watcher: ethereum event log collector
::
/- *eth-watcher, spider
/+ default-agent, verb, dbug
/+ ethereum, default-agent, verb, dbug
=, ethereum-types
=, able:jael
=, jael
::
=> |%
+$ card card:agent:gall

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

View File

@ -7,9 +7,7 @@
:: - receive timestamps, process events
::
/- eth-watcher
/+ default-agent, verb
=, ethereum
=, azimuth
/+ *ethereum, *azimuth, default-agent, verb
::
=> |%
+$ state-0
@ -254,8 +252,8 @@
?- -.diff
%history ~& [%got-history (lent loglist.diff)]
[loglist.diff state(qued ~, seen ~)]
%log ~& %got-log
[[event-log.diff ~] state]
%logs ~& %got-log
[loglist.diff state]
%disavow ~& %disavow-unimplemented
[~ state]
==

View File

@ -5,7 +5,7 @@
/- glob
/+ default-agent, verb, dbug
|%
++ hash 0v6.cmrce.5ass7.5gfqi.7c8cg.mdo7n
++ hash 0v5.hvt1e.ie7it.b7i7l.1r7jj.dn9ib
+$ state-0 [%0 hash=@uv glob=(unit (each glob:glob tid=@ta))]
+$ all-states
$% state-0

View File

@ -1,6 +1,6 @@
/- *resource
/+ store=graph-store, graph, default-agent, verb, dbug, pull-hook
~% %graph-pull-hook-top ..is ~
~% %graph-pull-hook-top ..part ~
|%
+$ card card:agent:gall
++ config
@ -22,16 +22,16 @@
dep ~(. (default:pull-hook this config) bowl)
gra ~(. graph bowl)
::
++ on-init on-init:def
++ on-save !>(~)
++ on-load on-load:def
++ on-poke on-poke:def
++ on-peek on-peek:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
++ on-agent on-agent:def
++ on-watch on-watch:def
++ on-leave on-leave:def
++ on-init on-init:def
++ on-save !>(~)
++ on-load on-load:def
++ on-poke on-poke:def
++ on-peek on-peek:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
++ on-agent on-agent:def
++ on-watch on-watch:def
++ on-leave on-leave:def
++ on-pull-nack
|= [=resource =tang]
^- (quip card _this)

View File

@ -6,7 +6,7 @@
/+ default-agent
/+ dbug
/+ push-hook
~% %graph-push-hook-top ..is ~
~% %graph-push-hook-top ..part ~
|%
+$ card card:agent:gall
++ config

View File

@ -3,7 +3,7 @@
::
/+ store=graph-store, sigs=signatures, res=resource, default-agent, dbug,
*migrate
~% %graph-store-top ..is ~
~% %graph-store-top ..part ~
|%
+$ card card:agent:gall
+$ versioned-state
@ -262,12 +262,14 @@
graphs (~(put by graphs) resource [graph mark])
update-logs (~(put by update-logs) resource (gas:orm-log ~ ~))
archive (~(del by archive) resource)
::
validators
?~ mark validators
(~(put in validators) u.mark)
==
%- zing
:~ (give [/updates /keys ~] [%add-graph resource graph mark overwrite])
:~ (give [/keys ~] %keys (~(put in ~(key by graphs)) resource))
(give [/updates ~] %add-graph resource *graph:store mark overwrite)
?~ mark ~
?: (~(has in validators) u.mark) ~
=/ wire /validator/[u.mark]
@ -295,6 +297,8 @@
|^
=/ [=graph:store mark=(unit mark:store)]
(~(got by graphs) resource)
~| "cannot add duplicate nodes to {<resource>}"
?< (check-for-duplicates graph ~(key by nodes))
=/ =update-log:store (~(got by update-logs) resource)
=. update-log
(put:orm-log update-log time [%0 time [%add-nodes resource nodes]])
@ -309,6 +313,31 @@
(add-node-list resource graph mark (sort-nodes nodes))
==
::
++ check-for-duplicates
|= [=graph:store nodes=(set index:store)]
^- ?
=/ node-list ~(tap in nodes)
|-
?~ node-list %.n
?: (has-node graph i.node-list) %.y
$(node-list t.node-list)
::
++ has-node
|= [=graph:store =index:store]
^- ?
=/ node=(unit node:store) ~
|-
?~ index
?=(^ node)
?~ t.index
?=(^ (get:orm graph i.index))
=. node (get:orm graph i.index)
?~ node %.n
?- -.children.u.node
%empty %.n
%graph $(graph p.children.u.node, index t.index)
==
::
++ sort-nodes
|= nodes=(map index:store node:store)
^- (list [index:store node:store])
@ -564,7 +593,9 @@
?< (~(has by archive) resource)
?> (~(has by graphs) resource)
=/ updates=(list [=time upd=logged-update:store])
(tap:orm-log update-log)
:: updates are time-ordered with most recent first
:: process with earliest first
(bap:orm-log update-log)
=| cards=(list card)
|- ^- (quip card _state)
?~ updates
@ -852,6 +883,64 @@
:+ %add-nodes
[ship term]
(~(gas by *(map index:store node:store)) [index u.node] ~)
::
[%x %node-siblings ?(%older %younger) @ @ @ *]
=/ older ?=(%older i.t.t.path)
=/ =ship (slav %p i.t.t.t.path)
=/ =term i.t.t.t.t.path
=/ count (slav %ud i.t.t.t.t.t.path)
=/ =index:store
(turn t.t.t.t.t.t.path (cury slav %ud))
=/ parent=index:store
(scag (dec (lent index)) index)
=/ graph
(get-node-children ship term parent)
?~ graph [~ ~]
:- ~ :- ~ :- %graph-update
!> ^- update:store
:+ %0
now.bowl
:+ %add-nodes
[ship term]
%- ~(gas by *(map index:store node:store))
:: TODO time complexity not desirable
:: replace with custom ordered map functions
%+ turn
=- ?.(older (slag (safe-sub (lent -) count) -) (scag count -))
%- tap:orm
%+ subset:orm u.graph
=/ idx
(snag (dec (lent index)) index)
?:(older [`idx ~] [~ `idx])
|= [=atom =node:store]
^- [index:store node:store]
[(snoc parent atom) node]
::
[%x ?(%newest %oldest) @ @ @ *]
=/ newest ?=(%newest i.t.path)
=/ =ship (slav %p i.t.t.path)
=/ =term i.t.t.t.path
=/ count=@ud
(slav %ud i.t.t.t.t.path)
=/ =index:store
(turn t.t.t.t.t.path (cury slav %ud))
=/ children
(get-node-children ship term index)
?~ children [~ ~]
:- ~ :- ~ :- %graph-update
!> ^- update:store
:+ %0
now.bowl
:+ %add-nodes
[ship term]
%- ~(gas by *(map index:store node:store))
%+ turn
%+ scag count
%- ?:(newest same flop)
(tap:orm u.children)
|= [=atom =node:store]
^- [index:store node:store]
[(snoc index atom) node]
::
[%x %node-children-subset @ @ @ @ @ *]
=/ =ship (slav %p i.t.t.path)
@ -908,6 +997,28 @@
(bind result |=([=time update:store] time))
==
::
++ safe-sub
|= [a=@ b=@]
^- @
?: (gte b a)
0
(sub a b)
::
++ get-node-children
|= [=ship =term =index:store]
^- (unit graph:store)
?: ?=(~ index)
=/ graph
(~(get by graphs) [ship term])
?~ graph ~
`p.u.graph
=/ node
(get-node ship term index)
?~ node ~
?: ?=(%empty -.children.u.node)
~
`p.children.u.node
::
++ get-node
|= [=ship =term =index:store]
^- (unit node:store)
@ -946,7 +1057,7 @@
[%try-rejoin @ *]
=/ rid=resource:store (de-path:res t.t.wire)
=/ nack-count (slav %ud i.t.wire)
?> ?=([%b %wake *] sign-arvo)
?> ?=([%behn %wake *] sign-arvo)
~? ?=(^ error.sign-arvo)
"behn errored in backoff timers, continuing anyway"
=/ new=^wire [%try-rejoin (scot %ud +(nack-count)) t.t.wire]

View File

@ -4,7 +4,7 @@
::
/- *group, *invite-store, *resource
/+ default-agent, verb, dbug, store=group-store, grpl=group, pull-hook
~% %group-hook-top ..is ~
~% %group-hook-top ..part ~
|%
+$ card card:agent:gall
::
@ -42,7 +42,9 @@
++ on-pull-nack
|= [=resource =tang]
^- (quip card _this)
[~ this]
:_ this
=- [%pass / %agent [our.bowl %group-store] %poke -]~
group-update+!>([%remove-group resource ~])
++ on-pull-kick
|= =resource
^- (unit path)

View File

@ -5,7 +5,7 @@
/- *group, *invite-store
/+ default-agent, verb, dbug, store=group-store, grpl=group, push-hook,
resource
~% %group-hook-top ..is ~
~% %group-hook-top ..part ~
|%
+$ card card:agent:gall

View File

@ -234,7 +234,7 @@
(on-arvo:def wire sign-arvo)
=/ =resource (de-path:resource t.t.wire)
=/ nack-count=@ud (slav %ud i.t.wire)
?> ?=([%b %wake *] sign-arvo)
?> ?=([%behn %wake *] sign-arvo)
~? ?=(^ error.sign-arvo)
"behn errored in backoff timers, continuing anyway"
:_ this

View File

@ -1,214 +1,22 @@
:: hark-chat-hook: notifications for chat-store [landscape]
::
/- store=hark-store, post, group-store, metadata-store, hook=hark-chat-hook
/+ resource, metadata, default-agent, dbug, chat-store, grpl=group
/+ default-agent
::
~% %hark-chat-hook-top ..is ~
|%
+$ card card:agent:gall
+$ versioned-state
$% state-0
==
::
+$ state-0
$: %0
watching=(set path)
mentions=_&
==
::
--
::
=| state-0
=* state -
::
=>
|_ =bowl:gall
::
++ give
|= [paths=(list path) =update:hook]
^- (list card)
[%give %fact paths hark-chat-hook-update+!>(update)]~
::
++ watch-chat
^- card
[%pass /chat %agent [our.bowl %chat-store] %watch /all]
--
%- agent:dbug
^- agent:gall
~% %hark-chat-hook-agent ..card ~
|_ =bowl:gall
+* this .
ha ~(. +> bowl)
def ~(. (default-agent this %|) bowl)
met ~(. metadata bowl)
grp ~(. grpl bowl)
::
++ on-init
:_ this
~[watch-chat:ha]
::
++ on-save !>(state)
++ on-init [~ this]
++ on-save !>(~)
++ on-load
|= old=vase
^- (quip card _this)
:_ this(state !<(state-0 old))
?: (~(has by wex.bowl) [/chat our.bowl %chat-store])
~
~[watch-chat:ha]
::
++ on-watch
|= =path
^- (quip card _this)
=^ cards state
?+ path (on-watch:def path)
::
[%updates ~]
:_ state
%+ give:ha ~
:* %initial
watching
==
==
[cards this]
::
++ on-poke
~/ %hark-chat-hook-poke
|= [=mark =vase]
^- (quip card _this)
|^
?> (team:title our.bowl src.bowl)
=^ cards state
?+ mark (on-poke:def mark vase)
%hark-chat-hook-action
(hark-chat-hook-action !<(action:hook vase))
==
[cards this]
::
++ hark-chat-hook-action
|= =action:hook
^- (quip card _state)
|^
:- (give:ha ~[/updates] action)
?- -.action
%listen (listen +.action)
%ignore (ignore +.action)
%set-mentions (set-mentions +.action)
==
++ listen
|= chat=path
^+ state
state(watching (~(put in watching) chat))
::
++ ignore
|= chat=path
^+ state
state(watching (~(del in watching) chat))
::
++ set-mentions
|= ment=?
^+ state
state(mentions ment)
--
--
::
++ on-agent
~/ %hark-chat-hook-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
|^
?+ -.sign (on-agent:def wire sign)
%kick
:_ this
?. ?=([%chat ~] wire)
~
~[watch-chat:ha]
::
%fact
?. ?=(%chat-update p.cage.sign)
(on-agent:def wire sign)
=^ cards state
(chat-update !<(update:chat-store q.cage.sign))
[cards this]
==
::
++ chat-update
|= =update:chat-store
^- (quip card _state)
?+ -.update `state
%initial (process-initial +.update)
%create (process-new +.update)
::
%message
:_ state
(process-envelope path.update envelope.update)
::
%messages
:_ state
%- zing
(turn envelopes.update (cury process-envelope path.update))
==
++ process-initial
|= =inbox:chat-store
^- (quip card _state)
=/ keys=(list path)
~(tap in ~(key by inbox))
=| cards=(list card)
|-
?~ keys
[cards state]
=* path i.keys
=^ cs state
(process-new path)
$(cards (weld cards cs), keys t.keys)
::
++ process-new
|= chat=path
^- (quip card _state)
=/ groups=(list path)
(groups-from-resource:met %chat chat)
?~ groups
`state
?: (is-managed-path:grp i.groups)
`state
`state(watching (~(put in watching) chat))
::
++ is-mention
|= =envelope:chat-store
?. ?=(%text -.letter.envelope) %.n
?& mentions
?= ^
(find (scow %p our.bowl) (trip text.letter.envelope))
==
::
++ is-notification
|= [=path =envelope:chat-store]
?& (~(has in watching) path)
!=(author.envelope our.bowl)
==
::
++ process-envelope
|= [=path =envelope:chat-store]
^- (list card)
=/ mention=?
(is-mention envelope)
?. ?|(mention (is-notification path envelope))
~
=/ =index:store
[%chat path mention]
=/ =contents:store
[%chat ~[envelope]]
~[(poke-store %add index when.envelope %.n contents)]
::
++ poke-store
|= =action:store
^- card
=- [%pass /store %agent [our.bowl %hark-store] %poke -]
hark-action+!>(action)
--
::
++ on-peek on-peek:def
::
|= =vase
:_ this
[%pass /chat %agent [our.bowl %chat-store] %leave ~]~
++ on-arvo on-arvo:def
++ on-agent on-agent:def
++ on-poke on-poke:def
++ on-peek on-peek:def
++ on-watch on-watch:def
++ on-leave on-leave:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
--

View File

@ -1,9 +1,10 @@
:: hark-graph-hook: notifications for graph-store [landscape]
::
/- store=hark-store, post, group-store, metadata-store, hook=hark-graph-hook
/+ resource, metadata, default-agent, dbug, graph-store
/- 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
::
~% %hark-graph-hook-top ..is ~
::
~% %hark-graph-hook-top ..part ~
|%
+$ card card:agent:gall
+$ versioned-state
@ -17,29 +18,28 @@
watch-on-self=_&
==
::
+$ notif-kind
[name=@t parent-lent=@ud mode=?(%each %count %none) watch=?]
::
++ scry
|* [[our=@p now=@da] =mold p=path]
?> ?=(^ p)
?> ?=(^ t.p)
.^(mold i.p (scot %p our) i.t.p (scot %da now) t.t.p)
::
++ scry-conversion
|= [[our=@p now=@da] desk=term =mark]
~+
%^ scry [our now]
tube:clay
/cc/[desk]/[mark]/notification-kind
::
--
::
=| state-0
=* state -
::
=>
|_ =bowl:gall
::
++ scry
|* [=mold p=path]
?> ?=(^ p)
?> ?=(^ t.p)
.^(mold i.p (scot %p our.bowl) i.t.p (scot %da now.bowl) t.t.p)
::
++ give
|= [paths=(list path) =update:hook]
^- (list card)
[%give %fact paths hark-graph-hook-update+!>(update)]~
::
++ watch-graph
^- card
[%pass /graph %agent [our.bowl %graph-store] %watch /updates]
--
=<
%- agent:dbug
^- agent:gall
~% %hark-graph-hook-agent ..card ~
@ -48,6 +48,8 @@
ha ~(. +> bowl)
def ~(. (default-agent this %|) bowl)
met ~(. metadata bowl)
grp ~(. grouplib bowl)
gra ~(. graph bowl)
::
++ on-init
:_ this
@ -57,7 +59,22 @@
++ on-load
|= old=vase
^- (quip card _this)
`this(state !<(state-0 old))
:_ this(state !<(state-0 old))
%+ welp
?: (~(has by wex.bowl) [/graph our.bowl %graph-store])
~
~[watch-graph:ha]
%+ turn
^- (list mark)
:~ %graph-validator-chat
%graph-validator-link
%graph-validator-publish
==
|= =mark
^- card
=/ =wire /validator/[mark]
=/ =rave:clay [%sing %c [%da now.bowl] /[mark]/notification-kind]
[%pass wire %arvo %c %warp our.bowl [%home `rave]]
::
++ on-watch
|= =path
@ -141,127 +158,245 @@
(graph-update !<(update:graph-store q.cage.sign))
[cards this]
==
++ add-graph
|= rid=resource
^- (quip card _state)
?. &(watch-on-self =(our.bowl entity.rid))
[~ state]
`state(watching (~(put in watching) [rid ~]))
::
++ graph-update
|= =update:graph-store
^- (quip card _state)
?: ?=(%add-graph -.q.update)
(add-graph resource.q.update)
?. ?=(%add-nodes -.q.update)
[~ state]
=/ group=resource
(need (group-from-app-resource:met %graph resource.q.update))
=/ =metadata:metadata-store
(need (peek-metadata:met %graph group resource.q.update))
=* rid resource.q.update
=+ %+ scry:ha
,mark=(unit mark)
/gx/graph-store/graph-mark/(scot %p entity.rid)/[name.rid]/noun
=+ %+ scry:ha
,=tube:clay
/cc/[q.byk.bowl]/[(fall mark %graph-validator-link)]/notification-kind
=/ nodes=(list [p=index:graph-store q=node:graph-store])
~(tap by nodes.q.update)
=| cards=(list card)
|^
?~ nodes
[cards state]
=* index p.i.nodes
=* node q.i.nodes
=^ node-cards state
(check-node node tube)
%_ $
nodes t.nodes
cards (weld node-cards cards)
?+ -.q.update `state
%add-graph (add-graph resource.q.update)
::
?(%remove-graph %archive-graph)
(remove-graph resource.q.update)
::
%add-nodes
=* rid resource.q.update
(check-nodes ~(val by nodes.q.update) rid)
==
::
++ check-node-children
|= [=node:graph-store =tube:clay]
^- (quip card _state)
?: ?=(%empty -.children.node)
[~ state]
=/ children=(list [=atom =node:graph-store])
(tap:orm:graph-store p.children.node)
=| cards=(list card)
|- ^- (quip card _state)
?~ children
[cards state]
=^ new-cards state
(check-node node.i.children tube)
%_ $
cards (weld cards new-cards)
children t.children
==
::
++ check-node
|= [=node:graph-store =tube:clay]
^- (quip card _state)
=^ child-cards state
(check-node-children node tube)
?: =(our.bowl author.post.node)
=^ self-cards state
(self-post node)
:_ state
(weld child-cards self-cards)
=+ !< notif-kind=(unit [name=@t parent-lent=@ud])
(tube !>([0 post.node]))
?~ notif-kind
[child-cards state]
=/ desc=@t
?: (is-mention contents.post.node)
%mention
name.u.notif-kind
=/ parent=index:post
(scag parent-lent.u.notif-kind index.post.node)
?. ?| =(desc %mention)
(~(has in watching) [rid parent])
==
[child-cards state]
=/ notif-index=index:store
[%graph group rid module.metadata desc]
=/ =contents:store
[%graph (limo post.node ~)]
:_ state
%+ snoc child-cards
(add-unread notif-index [time-sent.post.node %.n contents])
::
++ is-mention
|= contents=(list content:post)
^- ?
?. mentions %.n
?~ contents %.n
?. ?=(%mention -.i.contents)
$(contents t.contents)
?: =(our.bowl ship.i.contents)
%.y
$(contents t.contents)
::
++ self-post
|= =node:graph-store
^- (quip card _state)
?. ?=(%.y watch-on-self)
[~ state]
`state(watching (~(put in watching) [rid index.post.node]))
::
++ add-unread
|= [=index:store =notification:store]
^- card
=- [%pass / %agent [our.bowl %hark-store] %poke -]
hark-action+!>([%add index notification])
::
--
::
++ remove-graph
|= rid=resource
=/ unwatched
%- ~(gas in *_watching)
%+ skim ~(tap in watching)
|= [r=resource idx=index:graph-store]
=(r rid)
:_ state(watching (~(dif in watching) unwatched))
^- (list card)
:- (poke-hark:ha %remove-graph rid)
%- zing
%+ turn ~(tap in unwatched)
|= [r=resource =index:graph-store]
(give:ha ~[/updates] %ignore r index)
::
++ 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)
:_ state(watching (~(put in watching) [rid ~]))
(weld cards (give:ha ~[/updates] %listen [rid ~]))
::
::
++ check-nodes
|= $: nodes=(list node:graph-store)
rid=resource
==
=/ group=(unit resource)
(group-from-app-resource: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)
--
::
++ on-peek on-peek:def
::
++ on-leave on-leave:def
++ on-arvo on-arvo:def
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card _this)
?+ wire (on-arvo:def wire sign-arvo)
::
[%validator @ ~]
:_ this
=* validator i.t.wire
=/ =rave:clay [%next %c [%da now.bowl] /[validator]/notification-kind]
[%pass wire %arvo %c %warp our.bowl [%home `rave]]~
==
++ on-fail on-fail:def
--
::
|_ =bowl:gall
::
::
++ give
|= [paths=(list path) =update:hook]
^- (list card)
[%give %fact paths hark-graph-hook-update+!>(update)]~
::
++ watch-graph
^- card
[%pass /graph %agent [our.bowl %graph-store] %watch /updates]
::
++ poke-hark
|= =action:store
^- card
=- [%pass / %agent [our.bowl %hark-store] %poke -]
hark-action+!>(action)
::
++ is-mention
|= contents=(list content:post)
^- ?
?. mentions %.n
?~ contents %.n
?. ?=(%mention -.i.contents)
$(contents t.contents)
?: =(our.bowl ship.i.contents)
%.y
$(contents t.contents)
::
++ handle-update
|_ $: rid=resource :: input
updates=(list node:graph-store)
group=resource
module=term
hark-pokes=(list action:store) :: output
new-watches=(list index:graph-store)
==
++ update-core .
::
++ abed
|= [r=resource upds=(list node:graph-store) grp=resource mod=term]
update-core(rid r, updates upds, group grp, module mod)
::
++ get-conversion
^- tube:clay
=+ %^ scry [our now]:bowl
,mark=(unit mark)
/gx/graph-store/graph-mark/(scot %p entity.rid)/[name.rid]/noun
?~ mark
|=(v=vase !>(~))
(scry-conversion [our now]:bowl q.byk.bowl u.mark)
::
++ abet
^- (quip card _state)
:_ state(watching (~(uni in watching) (silt (turn new-watches (lead rid)))))
^- (list card)
%+ welp (turn (flop hark-pokes) poke-hark)
%- zing
%+ turn (flop new-watches)
|=(=index:graph-store (give ~[/updates] [%listen rid index]))
::
++ hark
|= =action:store
^+ update-core
update-core(hark-pokes [action hark-pokes])
::
++ new-watch
|= =index:graph-store
update-core(new-watches [index new-watches])
::
++ check
|- ^+ update-core
?~ updates
update-core
=/ core=_update-core
(check-node i.updates)
=. updates.core t.updates
$(update-core core)
::
++ check-node-children
|= =node:graph-store
^+ update-core
?: ?=(%empty -.children.node)
update-core
=/ children=(list [=atom =node:graph-store])
(tap:orm:graph-store p.children.node)
|- ^+ update-core
?~ children
update-core
=. update-core (check-node node.i.children)
$(children t.children)
::
++ check-node
|= =node:graph-store
^+ update-core
=. update-core (check-node-children node)
=+ !< notif-kind=(unit notif-kind)
(get-conversion !>([0 post.node]))
?~ notif-kind
update-core
=/ desc=@t
?: (is-mention contents.post.node)
%mention
name.u.notif-kind
=* not-kind u.notif-kind
=/ parent=index:post
(scag parent-lent.not-kind index.post.node)
=/ notif-index=index:store
[%graph group rid module desc parent]
?: =(our.bowl author.post.node)
(self-post node notif-index [mode watch]:not-kind)
=. update-core
(update-unread-count not-kind notif-index [time-sent index]:post.node)
=? update-core
?| =(desc %mention)
(~(has in watching) [rid parent])
==
=/ =contents:store
[%graph (limo post.node ~)]
(add-unread notif-index [time-sent.post.node %.n contents])
update-core
::
++ update-unread-count
|= [=notif-kind =index:store time=@da ref=index:graph-store]
=/ =stats-index:store
(to-stats-index:store index)
?- mode.notif-kind
%count (hark %unread-count stats-index time)
%each (hark %unread-each stats-index ref time)
%none update-core
==
::
++ self-post
|= $: =node:graph-store
=index:store
mode=?(%count %each %none)
watch=?
==
^+ update-core
?: ?=(%none mode) update-core
=/ =stats-index:store
(to-stats-index:store index)
=. update-core
(hark %seen-index time-sent.post.node stats-index)
=? update-core ?=(%count mode)
(hark %read-count stats-index)
=? update-core &(watch watch-on-self)
(new-watch index.post.node)
update-core
::
++ add-unread
|= [=index:store =notification:store]
(hark %add-note index notification)
::
--
--

View File

@ -3,7 +3,7 @@
/- store=hark-store, post, group-store, metadata-store, hook=hark-group-hook
/+ resource, metadata, default-agent, dbug, graph-store
::
~% %hark-group-hook-top ..is ~
~% %hark-group-hook-top ..part ~
|%
+$ card card:agent:gall
+$ versioned-state

View File

@ -1,31 +1,49 @@
:: hark-store: notifications [landscape]
:: hark-store: notifications and unread counts [landscape]
::
/- store=hark-store, post, group-store, metadata-store
/+ resource, metadata, default-agent, dbug, graph-store
:: hark-store can store unread counts differently, depending on the
:: resource.
:: - last seen. This way, hark-store simply stores an index into
:: graph-store, which represents the last "seen" item, useful for
:: high-volume applications which are intrinsically time-ordered. i.e.
:: chats, comments
:: - each. Hark-store will store an index for each item that is unread.
:: Usefull for non-linear, low-volume applications, i.e. blogs,
:: collections
::
/- post, group-store, metadata-store, store=hark-store
/+ resource, metadata, default-agent, dbug, graph-store, graphl=graph, verb, store=hark-store
::
~% %hark-store-top ..is ~
::
~% %hark-store-top ..part ~
|%
+$ card card:agent:gall
+$ versioned-state
$% state-0
$% state:state-zero:store
state:state-one:store
state-2
==
+$ unread-stats
[indices=(set index:graph-store) last=@da]
::
+$ state-0
$: %0
+$ state-2
$: %2
unreads-each=(jug stats-index:store index:graph-store)
unreads-count=(map stats-index:store @ud)
last-seen=(map stats-index:store @da)
=notifications:store
archive=notifications:store
last-seen=@da
current-timebox=@da
dnd=_|
==
::
+$ inflated-state
$: state-0
$: state-2
cache
==
:: $cache: useful to have precalculated, but can be derived from state
:: albeit expensively
+$ cache
$: unread-count=@ud
by-index=(jug index:store @da)
$: by-index=(jug stats-index:store @da)
~
==
::
@ -36,6 +54,7 @@
=* state -
::
=<
%+ verb |
%- agent:dbug
^- agent:gall
~% %hark-store-agent ..card ~
@ -44,6 +63,7 @@
ha ~(. +> bowl)
def ~(. (default-agent this %|) bowl)
met ~(. metadata bowl)
gra ~(. graphl bowl)
::
++ on-init
:_ this
@ -54,16 +74,118 @@
|= =old=vase
^- (quip card _this)
=/ old
!<(state-0 old-vase)
=. notifications.old
(gas:orm *notifications:store (tap:orm notifications.old))
=. archive.old
(gas:orm *notifications:store (tap:orm archive.old))
`this(-.state old, +.state (inflate-cache old))
!<(versioned-state old-vase)
=| cards=(list card)
|^
?- -.old
%2
:- cards
this(-.state old, +.state (inflate-cache:ha old))
::
%1
%_ $
::
old
%* . *state-2
unreads-each ((convert-unread ,(set index:graph-store)) uni-by unreads-each.old)
unreads-count ((convert-unread ,@ud) add unreads-count.old)
last-seen ((convert-unread ,@da) max last-seen.old)
notifications notifications.old
archive archive.old
current-timebox current-timebox.old
dnd dnd.old
==
==
::
%0
%_ $
::
old
%* . *state:state-one:store
notifications (convert-notifications-1 notifications.old)
archive (convert-notifications-1 archive.old)
current-timebox current-timebox.old
dnd dnd.old
==
==
==
:: discard publish edits
++ uni-by
|= [a=(set index:graph-store) b=(set index:graph-store)]
=/ merged
(~(uni in a) b)
%- ~(gas in *(set index:graph-store))
%+ skip ~(tap in merged)
|=(=index:graph-store &(=((lent index) 3) !=(-:(flop index) 1)))
::
++ convert-unread
|* value=mold
|= [combine=$-([value value] value) unreads=(map index:store value)]
^- (map stats-index:store value)
%+ roll
~(tap in unreads)
|= [[=index:store val=value] out=(map stats-index:store value)]
=/ old=value
(~(gut by unreads) index (combine))
=/ =stats-index:store
(to-stats-index:store index)
(~(put by out) stats-index (combine old val))
::
++ convert-notifications-1
|= old=notifications:state-zero:store
%+ gas:orm *notifications:store
^- (list [@da timebox:store])
%+ murn
(tap:orm:state-zero:store old)
|= [time=@da =timebox:state-zero:store]
^- (unit [@da timebox:store])
=/ new-timebox=timebox:store
(convert-timebox-1 timebox)
?: =(0 ~(wyt by new-timebox))
~
`[time new-timebox]
::
++ convert-timebox-1
|= =timebox:state-zero:store
^- timebox:store
%- ~(gas by *timebox:store)
^- (list [index:store notification:store])
%+ murn
~(tap by timebox)
|= [=index:state-zero:store =notification:state-zero:store]
^- (unit [index:store notification:store])
=/ new-index=(unit index:store)
(convert-index-1 index)
=/ new-notification=(unit notification:store)
(convert-notification-1 notification)
?~ new-index ~
?~ new-notification ~
`[u.new-index u.new-notification]
::
++ convert-index-1
|= =index:state-zero:store
^- (unit index:store)
?+ -.index `index
%chat ~
::
%graph
=, index
`[%graph group graph module description ~]
==
::
++ convert-notification-1
|= =notification:state-zero:store
^- (unit notification:store)
?: ?=(%chat -.contents.notification)
~
`notification
--
::
++ on-watch
|= =path
^- (quip card _this)
?> (team:title [src our]:bowl)
|^
?+ path (on-watch:def path)
::
@ -76,32 +198,35 @@
^- update:store
:- %more
^- (list update:store)
:- unreads
:+ [%set-dnd dnd]
[%count unread-count]
%+ weld
%+ turn
%+ scag 3
(tap-nonempty:ha archive)
(timebox-update &)
%+ turn
%+ scag 3
(tap-nonempty:ha notifications)
(timebox-update |)
:- give-unreads
[%set-dnd dnd]~
::
++ unreads
++ give-since-unreads
^- (list [stats-index:store stats:store])
%+ turn
~(tap by unreads-count)
|= [=stats-index:store count=@ud]
?> ?=(%graph -.stats-index)
:* stats-index
~(wyt in (~(gut by by-index) stats-index ~))
[%count count]
(~(gut by last-seen) stats-index *time)
==
++ give-each-unreads
^- (list [stats-index:store stats:store])
%+ turn
~(tap by unreads-each)
|= [=stats-index:store indices=(set index:graph-store)]
:* stats-index
~(wyt in (~(gut by by-index) stats-index ~))
[%each indices]
(~(gut by last-seen) stats-index *time)
==
::
++ give-unreads
^- update:store
:- %unreads
^- (list [index:store @ud])
%+ turn
~(tap by by-index)
|=([=index:store =(set @da)] [index ~(wyt in set)])
::
++ timebox-update
|= archived=?
|= [time=@da =timebox:store]
^- update:store
[%timebox time archived ~(tap by timebox)]
(weld give-each-unreads give-since-unreads)
--
::
++ on-peek
@ -139,115 +264,14 @@
=^ cards state
?+ mark (on-poke:def mark vase)
%hark-action (hark-action !<(action:store vase))
%noun ~& +.state [~ state]
==
[cards this]
::
++ hark-action
|= =action:store
^- (quip card _state)
|^
?- -.action
%add (add +.action)
%archive (do-archive +.action)
%seen seen
%read (read +.action)
%read-index (read-index +.action)
%unread (unread +.action)
%set-dnd (set-dnd +.action)
==
++ add
|= [=index:store =notification:store]
^- (quip card _state)
=/ =timebox:store
(gut-orm:ha notifications last-seen)
=/ existing-notif
(~(get by timebox) index)
=/ new=notification:store
?~ existing-notif
notification
(merge-notification:ha u.existing-notif notification)
=/ new-read=?
?~ existing-notif
%.y
read.u.existing-notif
=. read.new %.n
=/ new-timebox=timebox:store
(~(put by timebox) index new)
:- (give:ha [/updates]~ %added last-seen index new)
%_ state
+ ?.(new-read +.state (upd-unreads:ha index last-seen %.n))
notifications (put:orm notifications last-seen new-timebox)
==
++ read-index
|= =index:store
^- (quip card _state)
=/ times=(list @da)
~(tap in (~(gut by by-index) index ~))
=| cards=(list card)
|-
?~ times
[cards state]
=* time i.times
=^ crds state
(read time index)
$(cards (weld cards crds), times t.times)
::
++ do-archive
|= [time=@da =index:store]
^- (quip card _state)
=/ =timebox:store
(gut-orm:ha notifications time)
=/ =notification:store
(~(got by timebox) index)
=/ new-timebox=timebox:store
(~(del by timebox) index)
:- (give:ha [/updates]~ %archive time index)
%_ state
+ ?.(read.notification (upd-unreads:ha index time %.y) +.state)
::
notifications
(put:orm notifications time new-timebox)
::
archive
%^ jub-orm:ha archive time
|= archive-box=timebox:store
^- timebox:store
(~(put by archive-box) index notification(read %.y))
==
::
++ read
|= [time=@da =index:store]
^- (quip card _state)
:- (give:ha [/updates]~ %read time index)
%_ state
+ (upd-unreads:ha index time %.y)
unread-count (dec unread-count)
notifications (change-read-status:ha time index %.y)
==
::
++ unread
|= [time=@da =index:store]
^- (quip card _state)
:- (give:ha [/updates]~ %unread time index)
%_ state
+ (upd-unreads:ha index time %.n)
unread-count +(unread-count)
notifications (change-read-status:ha time index %.n)
==
::
++ seen
^- (quip card _state)
:_ state(last-seen now.bowl)
:~ cancel-autoseen:ha
autoseen-timer:ha
==
::
++ set-dnd
|= d=?
^- (quip card _state)
:_ state(dnd d)
(give:ha [/updates]~ %set-dnd d)
--
abet:translate:(abed:poke-engine:ha action)
--
::
++ on-agent on-agent:def
@ -258,53 +282,299 @@
^- (quip card _this)
?. ?=([%autoseen ~] wire)
(on-arvo:def wire sign-arvo)
?> ?=([%b %wake *] sign-arvo)
:_ this(last-seen now.bowl)
?> ?=([%behn %wake *] sign-arvo)
:_ this(current-timebox now.bowl)
~[autoseen-timer:ha]
::
++ on-fail on-fail:def
--
|_ =bowl:gall
+* met ~(. metadata bowl)
::
++ tap-nonempty
|= =notifications:store
^- (list [@da timebox:store])
%+ skip (tap:orm notifications)
|=([@da =timebox:store] =(0 ~(wyt by timebox)))
++ poke-engine
|_ [in=action:store out=(list update:store) cards=(list card)]
++ poke-core .
::
++ abed
|= =action:store poke-core(in action)
::
++ abet
^- (quip card _state)
:_ state
%+ snoc (flop cards)
[%give %fact ~[/updates] %hark-update !>([%more (flop out)])]
::
++ give
|= =update:store poke-core(out [update out])
::
++ emit
|= =card poke-core(cards [card cards])
::
++ translate
^+ poke-core
?+ -.in poke-core
::
%add-note (add-note +.in)
%archive (do-archive +.in)
::
%unread-count (unread-count +.in)
%read-count (read-count +.in)
::
%read-each (read-each +.in)
%unread-each (unread-each +.in)
::
%read-note (read-note +.in)
%unread-note (unread-note +.in)
::
%seen-index (seen-index +.in)
%remove-graph (remove-graph +.in)
%set-dnd (set-dnd +.in)
%seen seen
==
::
:: +| %note
::
:: notification tracking
++ upd-cache
|= [read=? time=@da =index:store]
poke-core(+.state (^upd-cache read time index))
::
++ put-notifs
|= [time=@da =timebox:store]
poke-core(notifications (put:orm notifications time timebox))
::
++ add-note
|= [=index:store =notification:store]
^+ poke-core
=/ =timebox:store
(gut-orm notifications current-timebox)
=/ existing-notif
(~(get by timebox) index)
=/ new=notification:store
(merge-notification existing-notif notification)
=/ new-read=?
?~ existing-notif %.y
read.u.existing-notif
=/ new-timebox=timebox:store
(~(put by timebox) index new)
=. poke-core (put-notifs current-timebox new-timebox)
=? poke-core new-read
(upd-cache %.n current-timebox index)
(give %added current-timebox index new)
::
++ do-archive
|= [time=@da =index:store]
^+ poke-core
=/ =timebox:store
(gut-orm notifications time)
=/ =notification:store
(~(got by timebox) index)
=/ new-timebox=timebox:store
(~(del by timebox) index)
=? poke-core !read.notification
(upd-cache %.y time index)
=. poke-core
(put-notifs time new-timebox)
=. archive
%^ jub-orm archive time
|= archive-box=timebox:store
(~(put by archive-box) index notification(read %.y))
(give %archive time index)
::
++ change-read-status
|= [time=@da =index:store read=?]
=. poke-core (upd-cache read time index)
%_ poke-core
notifications
%^ jub-orm notifications time
|= =timebox:store
%+ ~(jab by timebox) index
|= n=notification:store
?>(!=(read read.n) n(read read))
==
::
++ read-note
|= [time=@da =index:store]
%. [%read-note time index]
give:(change-read-status time index %.y)
::
++ unread-note
|= [time=@da =index:store]
%. [%unread-note time index]
give:(change-read-status time index %.n)
::
:: +| %each
::
:: each unread tracking
::
++ unread-each
|= [=stats-index:store unread=index:graph-store time=@da]
=. poke-core (seen-index time stats-index)
%+ jub-unreads-each:(give %unread-each stats-index unread time)
stats-index
|= indices=(set index:graph-store)
(~(put ^in indices) unread)
::
++ read-index-each
|= [=stats-index:store ref=index:graph-store]
%+ read-index stats-index
%+ skim
~(tap ^in (~(get ju by-index) stats-index))
|= time=@da
=/ =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
(lien list.contents.not |=(p=post:post =(index.p ref)))
::
++ read-each
|= [=stats-index:store ref=index:graph-store]
=. poke-core (read-index-each stats-index ref)
%+ jub-unreads-each:(give %read-each stats-index ref)
stats-index
|= indices=(set index:graph-store)
(~(del ^in indices) ref)
::
++ jub-unreads-each
|= $: =stats-index:store
f=$-((set index:graph-store) (set index:graph-store))
==
poke-core(unreads-each (jub stats-index f))
::
++ unread-count
|= [=stats-index:store time=@da]
=/ new-count
+((~(gut by unreads-count) stats-index 0))
=. unreads-count
(~(put by unreads-count) stats-index new-count)
(seen-index:(give %unread-count stats-index time) time stats-index)
::
++ read-count
|= =stats-index:store
=. unreads-count (~(put by unreads-count) stats-index 0)
=/ times=(list @da)
~(tap ^in (~(get ju by-index) stats-index))
(give:(read-index stats-index times) %read-count stats-index)
::
++ read-index
|= [=stats-index:store times=(list @da)]
|-
?~ times poke-core
=/ core
(read-stats-index i.times stats-index)
$(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)
=/ core
(read-note time i.keys)
$(poke-core core, keys t.keys)
::
++ seen-index
|= [time=@da =stats-index:store]
=/ new-time=@da
(max time (~(gut by last-seen) stats-index 0))
=. last-seen
(~(put by last-seen) stats-index new-time)
(give %seen-index new-time stats-index)
::
++ remove-graph
|= rid=resource
|^
=/ indices get-stats-indices
=. poke-core
(give %remove-graph rid)
=. poke-core
(remove-notifications indices)
=. unreads-count
((dif-map-by-key ,@ud) unreads-count indices)
=. unreads-each
%+ (dif-map-by-key ,(set index:graph-store))
unreads-each indices
=. last-seen
((dif-map-by-key ,@da) last-seen indices)
=. by-index
((dif-map-by-key ,(set @da)) by-index indices)
poke-core
::
++ get-stats-indices
%- ~(gas ^in *(set stats-index:store))
%+ skim
;: weld
~(tap ^in ~(key by unreads-count))
~(tap ^in ~(key by last-seen))
~(tap ^in ~(key by unreads-each))
~(tap ^in ~(key by by-index))
==
|= =stats-index:store
?. ?=(%graph -.stats-index) %.n
=(graph.stats-index rid)
::
++ dif-map-by-key
|* value=mold
|= [=(map stats-index:store value) =(set stats-index:store)]
=/ to-remove ~(tap ^in set)
|-
?~ to-remove map
=. map
(~(del by map) i.to-remove)
$(to-remove t.to-remove)
::
++ remove-notifications
|= =(set stats-index:store)
^+ poke-core
=/ indices
~(tap ^in set)
|-
?~ indices poke-core
=/ times=(list @da)
~(tap ^in (~(get ju by-index) i.indices))
=. poke-core
(read-index i.indices times)
$(indices t.indices)
--
::
++ seen
=> (emit cancel-autoseen)
=> (emit autoseen-timer)
poke-core(current-timebox now.bowl)
::
++ set-dnd
|= d=?
(give:poke-core(dnd d) %set-dnd d)
--
::
++ merge-notification
|= [existing=notification:store new=notification:store]
|= [existing=(unit notification:store) new=notification:store]
^- notification:store
?- -.contents.existing
::
%chat
?> ?=(%chat -.contents.new)
existing(list.contents (weld list.contents.existing list.contents.new))
?~ existing new
?- -.contents.u.existing
::
%graph
?> ?=(%graph -.contents.new)
existing(list.contents (weld list.contents.existing list.contents.new))
u.existing(read %.n, list.contents (weld list.contents.u.existing list.contents.new))
::
%group
?> ?=(%group -.contents.new)
existing(list.contents (weld list.contents.existing list.contents.new))
u.existing(read %.n, list.contents (weld list.contents.u.existing list.contents.new))
==
::
++ change-read-status
|= [time=@da =index:store read=?]
^+ notifications
%^ jub-orm notifications time
|= =timebox:store
%+ ~(jab by timebox) index
|= =notification:store
?> !=(read read.notification)
notification(read read)
:: +key-orm: +key:by for ordered maps
++ key-orm
|= =notifications:store
^- (list @da)
(turn (tap:orm notifications) |=([key=@da =timebox:store] key))
(turn (tap:orm notifications) |=([@da *] +<-))
:: +jub-orm: combo +jab/+gut for ordered maps
:: TODO: move to zuse.hoon
++ jub-orm
@ -313,6 +583,12 @@
=/ =timebox:store
(fun (gut-orm notifications time))
(put:orm notifications time timebox)
++ jub
|= [=stats-index:store f=$-((set index:graph-store) (set index:graph-store))]
^- (jug stats-index:store index:graph-store)
=/ val=(set index:graph-store)
(~(gut by unreads-each) stats-index ~)
(~(put by unreads-each) stats-index (f val))
:: +gut-orm: +gut:by for ordered maps
:: TODO: move to zuse.hoon
++ gut-orm
@ -323,37 +599,49 @@
++ autoseen-interval ~h3
++ cancel-autoseen
^- card
[%pass /autoseen %arvo %b %rest (add last-seen autoseen-interval)]
[%pass /autoseen %arvo %b %rest (add current-timebox autoseen-interval)]
::
++ autoseen-timer
^- card
[%pass /autoseen %arvo %b %wait (add now.bowl autoseen-interval)]
::
++ scry
|* [=mold p=path]
?> ?=(^ p)
?> ?=(^ t.p)
.^(mold i.p (scot %p our.bowl) i.t.p (scot %da now.bowl) t.t.p)
::
++ give
|= [paths=(list path) update=update:store]
^- (list card)
[%give %fact paths [%hark-update !>(update)]]~
::
++ upd-unreads
|= [=index:store time=@da read=?]
++ tap-nonempty
|= =notifications:store
^- (list [@da timebox:store])
%+ skim (tap:orm notifications)
|=([@da =timebox:store] !=(~(wyt by timebox) 0))
::
++ upd-cache
|= [read=? time=@da =index:store]
^+ +.state
%_ +.state
::
by-index
%. [index time]
%. [(to-stats-index:store index) time]
?: read
~(del ju by-index)
~(put ju by-index)
==
::
++ inflate-cache
|= state-0
|= state-2
^+ +.state
=/ nots=(list [p=@da =timebox:store])
(tap:orm notifications)
|- =* outer $
?~ nots
+.state
?~ nots +.state
=/ unreads ~(tap by timebox.i.nots)
|- =* inner $
?~ unreads
@ -363,6 +651,6 @@
?: read.notification
inner(unreads t.unreads)
=. +.state
(upd-unreads index p.i.nots %.n)
(upd-cache %.n p.i.nots index)
inner(unreads t.unreads)
--

View File

@ -1,7 +1,7 @@
:: herm: stand-in for term.c with http interface
::
/+ default-agent, dbug, verb
=, able:jael
=, jael
|%
+$ state-0 [%0 ~]
--
@ -65,7 +65,7 @@
:: pass on dill blits for the session
::
[%view %$ ~]
?. ?=([%d %blit *] sign-arvo)
?. ?=([%dill %blit *] sign-arvo)
~| [%unexpected-sign [- +<]:sign-arvo]
!!
:_ this
@ -78,7 +78,7 @@
[%tube @ @ ~]
=* from i.t.wire
=* to i.t.t.wire
?. ?=([%c %writ *] sign-arvo)
?. ?=([%clay %writ *] sign-arvo)
~| [%unexpected-sign [- +<]:sign-arvo]
!!
:_ this

File diff suppressed because one or more lines are too long

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

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.649a8f56804ea2cb643c.js"></script>
<script src="/~landscape/js/bundle/index.2ddb586104e8758c6863.js"></script>
</body>
</html>

View File

@ -100,8 +100,8 @@
^- (quip card _this)
=^ cards state
?+ sign-arvo (on-arvo:def wire sign-arvo)
[%e %bound *] `state
[%c *] (handle-build:lsp wire +.sign-arvo)
[%eyre %bound *] `state
[%clay *] (handle-build:lsp wire +.sign-arvo)
==
[cards this]
::
@ -234,7 +234,7 @@
`state
::
++ handle-build
|= [=path =gift:able:clay]
|= [=path =gift:clay]
^- (quip card _state)
?> ?=([%writ *] gift)
=/ uri=@t

View File

@ -1,5 +1,5 @@
/- lens, *sole
/+ base64, *server, default-agent
/+ *server, default-agent
/= lens-mark /mar/lens/command :: TODO: ask clay to build a $tube
=, format
|%
@ -51,6 +51,11 @@
++ on-poke
|= [=mark =vase]
^- (quip card:agent:gall _this)
::
?: &(?=(%noun mark) ?=(%cancel q.vase))
~& %lens-cancel
[~ this(job.state ~)]
::
?. ?=(%handle-http-request mark)
(on-poke:def mark vase)
=+ !<([eyre-id=@ta =inbound-request:eyre] vase)
@ -83,7 +88,7 @@
[%pass /export %agent [our.bowl app.source.com] %watch /export]~
::
%import
?~ enc=(de:base64 base64-jam.source.com)
?~ enc=(de:base64:mimes:html base64-jam.source.com)
!!
::
=/ c=* (cue q.u.enc)
@ -96,7 +101,7 @@
=/ jon
=/ =atom (jam (export-all our.bowl now.bowl))
=/ =octs [(met 3 atom) atom]
=/ enc (en:base64 octs)
=/ enc (en:base64:mimes:html octs)
(pairs:enjs:format file+s+output data+s+enc ~)
:_ this
%+ give-simple-payload:app eyre-id
@ -104,7 +109,7 @@
::
%import-all
~& %import-all
=/ enc (de:base64 base64-jam.source.com)
=/ enc (de:base64:mimes:html base64-jam.source.com)
?~ enc !!
=/ by-app ;;((list [@tas *]) (cue q.u.enc))
:_ this
@ -192,7 +197,7 @@
=/ jon=json
=/ =atom (jam data)
=/ =octs [(met 3 atom) atom]
=/ enc (en:base64 octs)
=/ enc (en:base64:mimes:html octs)
(pairs:enjs:format file+s+output data+s+enc ~)
::
:_ this
@ -222,13 +227,11 @@
[%mime p.fec (as-octs:mimes:html (jam q.fec))]
::
%sav
:: XX use +en:base64 or produce %mime a la %sag
::
%- some
:- %json
%- pairs:enjs:format
:~ file+s+(crip <`path`p.fec>)
data+s+(crip (en-base64:mimes:html q.fec))
data+s+(en:base64:mimes:html (met 3 q.fec) q.fec)
==
::
%mor

View File

@ -7,7 +7,7 @@
::
/- *metadata-store, *metadata-hook
/+ default-agent, dbug, verb, grpl=group, *migrate
~% %metadata-hook-top ..is ~
~% %metadata-hook-top ..part ~
|%
+$ card card:agent:gall
+$ versioned-state
@ -69,7 +69,7 @@
=/ nack-count=@ud (slav %ud i.t.wire)
=/ who=@p (slav %p i.t.t.wire)
=/ pax t.t.t.wire
?> ?=([%b %wake *] sign-arvo)
?> ?=([%behn %wake *] sign-arvo)
~? ?=(^ error.sign-arvo)
"behn errored in backoff timers, continuing anyway"
:_ this

View File

@ -85,190 +85,9 @@
++ on-load
|= =vase
^- (quip card _this)
=/ old !<(versioned-state vase)
=| cards=(list card)
|^
?: ?=(%6 -.old)
[cards this(state old)]
?: ?=(%5 -.old)
=/ =^associations
(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)
==
?: ?=(%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]
[r g]
::
++ rebuild-group-indices
|= =^associations
%- ~(gas ju *(jug group-path md-resource))
~(tap in ~(key by associations))
::
++ 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]]
::
++ migrate-app-to-graph-store
|= [app=@tas =^associations]
^+ associations
%- malt
%+ turn ~(tap by associations)
|= [[=group-path =md-resource] m=metadata]
^- [[^group-path ^md-resource] metadata]
?. =(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)]
--
=^ cards state
(on-load:mc vase)
[cards this]
::
++ on-poke
|= [=mark =vase]
@ -366,6 +185,208 @@
--
::
|_ =bowl:gall
::
++ on-load
|= =vase
^- (quip card _state)
=/ old !<(versioned-state vase)
=| cards=(list card)
|^
?: ?=(%6 -.old)
=/ =^associations
(migrate-app-to-graph-store %chat associations.old)
:- cards
%_ state
associations associations
::
resource-indices
(rebuild-resource-indices associations)
::
app-indices
(rebuild-app-indices associations)
::
group-indices
(rebuild-group-indices associations)
==
?: ?=(%5 -.old)
=/ =^associations
(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)
==
?: ?=(%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]
[r g]
::
++ rebuild-group-indices
|= =^associations
%- ~(gas ju *(jug group-path md-resource))
~(tap in ~(key by associations))
::
++ 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]]
::
++ migrate-app-to-graph-store
|= [app=@tas =^associations]
^+ associations
%- malt
%+ turn ~(tap by associations)
|= [[=group-path =md-resource] m=metadata]
^- [[^group-path ^md-resource] metadata]
?. =(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)]
--
++ poke-metadata-action
|= act=metadata-action
^- (quip card _state)
@ -379,9 +400,7 @@
|= arc=*
^- (quip card _state)
|^
=/ sty=state-6
[%6 (remake-metadata ;;(tree-metadata +.arc))]
[~ sty]
(on-load !>([%5 (remake-metadata ;;(tree-metadata +.arc))]))
::
+$ tree-metadata
$: associations=(tree [[group-path md-resource] metadata])

View File

@ -64,6 +64,9 @@
=| cards=(list card)
|-
?: ?=(%2 -.old-state)
=. cards
:_ cards
(act [%watch %group-store /groups %group-on-leave])
[cards this(state old-state)]
?: ?=(%1 -.old-state)
=. cards
@ -134,9 +137,9 @@
^- (quip card _this)
|^
?+ wire (on-agent:def wire sign)
[%observer @ ~] on-observer
[%thread-result @ ~] on-thread-result
[%thread-start @ @ ~] on-thread-start
[%observer @ ~] on-observer
[%thread-result @ @ ~] on-thread-result
[%thread-start @ @ ~] on-thread-start
==
::
++ on-observer
@ -167,7 +170,7 @@
=/ tid (scot %uv (sham eny.bowl))
:_ this
:~ :* %pass
[%thread-result i.t.wire ~]
[%thread-result i.t.wire tid ~]
%agent
[our.bowl %spider]
%watch
@ -184,7 +187,7 @@
==
::
++ on-thread-result
?> ?=([%thread-result @ ~] wire)
?> ?=([%thread-result @ @ ~] wire)
?+ -.sign (on-agent:def wire sign)
%kick [~ this]
%watch-ack [~ this]

View File

@ -10,7 +10,7 @@
:: talk to its own star.
::
/+ default-agent, verb
=* point point:able:kale
=* point point:kale
::
|%
+$ card card:agent:gall

View File

@ -5,9 +5,9 @@
:: looks at our invite tree, adds our siblings to group at +group-path
::
/- group-store, spider
/+ default-agent, verb
/+ ethereum, azimuth, default-agent, verb
=, ethereum-types
=, able:jael
=, jael
::
=> |%
++ group-path /invite-peers

View File

@ -4,7 +4,7 @@
::
/- *s3
/+ s3-json, default-agent, verb, dbug
~% %s3-top ..is ~
~% %s3-top ..part ~
|%
+$ card card:agent:gall
+$ versioned-state

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)
@ -362,7 +365,7 @@
=. starting.state
(~(jab by starting.state) yarn |=([=trying =vase] [%none vase]))
~| sign+[- +<]:sign-arvo
?> ?=([?(%b %c) %writ *] sign-arvo)
?> ?=([?(%behn %clay) %writ *] sign-arvo)
=/ =riot:clay p.sign-arvo
?~ riot
(thread-fail-not-running tid %build-thread-error *tang)
@ -392,17 +395,20 @@
++ handle-stop-thread
|= [=tid nice=?]
^- (quip card ^state)
=/ =yarn (~(got by tid.state) tid)
?: (has-yarn running.state yarn)
=/ yarn=(unit yarn) (~(get by tid.state) tid)
?~ yarn
~& %stopping-nonexistent-thread
[~ state]
?: (has-yarn running.state u.yarn)
?: nice
(thread-done yarn *vase)
(thread-fail yarn %cancelled ~)
?: (~(has by starting.state) yarn)
(thread-done u.yarn *vase)
(thread-fail u.yarn %cancelled ~)
?: (~(has by starting.state) u.yarn)
(thread-fail-not-running tid %stopped-before-started ~)
~& [%thread-not-started yarn]
~& [%thread-not-started u.yarn]
?: nice
(thread-done yarn *vase)
(thread-fail yarn %cancelled ~)
(thread-done u.yarn *vase)
(thread-fail u.yarn %cancelled ~)
::
++ take-input
|= [=yarn input=(unit input:strand)]
@ -486,7 +492,7 @@
++ thread-fail
|= [=yarn =term =tang]
^- (quip card ^state)
:: %- (slog leaf+"strand {<yarn>} failed" leaf+<term> tang)
::%- (slog leaf+"strand {<yarn>} failed" leaf+<term> tang)
=/ =tid (yarn-to-tid yarn)
=/ fail-cards (thread-say-fail tid term tang)
=^ cards state (thread-clean yarn)

View File

@ -3,4 +3,4 @@
:- %say
|= [* [her=ship ~] ~]
:- %aqua-events
[%init-ship her `*dawn-event:able:jael]~
[%init-ship her `*dawn-event:jael]~

View File

@ -12,145 +12,8 @@
arg=$@(~ [top=path ~])
~
==
::
:: we're creating an event series E whose lifecycle can be computed
:: with the urbit lifecycle formula L, `[2 [0 3] [0 2]]`. that is:
:: if E is the list of events processed by a computer in its life,
:: its final state is S, where S is nock(E L).
::
:: in practice, the first five nouns in E are: two boot formulas,
:: a hoon compiler as a nock formula, the same compiler as source,
:: and the arvo kernel as source.
::
:: after the first five special events, we enter an iterative
:: sequence of regular events which continues for the rest of the
:: computer's life. during this sequence, each state is a function
:: that, passed the next event, produces the next state.
::
:: a regular event is a `[date wire type data]` tuple, where `date` is a
:: 128-bit Urbit date; `wire` is an opaque path which output can
:: match to track causality; `type` is a symbol describing the type
:: of input; and `data` is input data specific to `type`.
::
:: in real life we don't actually run the lifecycle loop,
:: since real life is updated incrementally and also cares
:: about things like output. we couple to the internal
:: structure of the state machine and work directly with
:: the underlying arvo engine.
::
:: this arvo core, which is at `+7` (Lisp `cddr`) of the state
:: function (see its public interface in `sys/arvo`), gives us
:: extra features, like output, which are relevant to running
:: a real-life urbit vm, but don't affect the formal definition.
::
:: so a real-life urbit interpreter is coupled to the shape of
:: the arvo core. it becomes very hard to change this shape.
:: fortunately, it is not a very complex interface.
::
:- %noun
::
:: boot-one: lifecycle formula
::
=+ ^= boot-one
::
:: event 1 is the lifecycle formula which computes the final
:: state from the full event sequence.
::
:: the formal urbit state is always just a gate (function)
:: which, passed the next event, produces the next state.
::
=> [boot-formula=* full-sequence=*]
!= ::
:: first we use the boot formula (event 1) to set up
:: the pair of state function and main sequence. the boot
:: formula peels off the first 5 events
:: to set up the lifecycle loop.
::
=+ [state-gate main-sequence]=.*(full-sequence boot-formula)
::
:: in this lifecycle loop, we replace the state function
:: with its product, called on the next event, until
:: we run out of events.
::
|- ?@ main-sequence
state-gate
%= $
main-sequence +.main-sequence
state-gate .*(state-gate [%9 2 %10 [6 %1 -.main-sequence] %0 1])
==
::
:: boot-two: startup formula
::
=+ ^= boot-two
::
:: event 2 is the startup formula, which verifies the compiler
:: and starts the main lifecycle.
::
=> :* :: event 3: a formula producing the hoon compiler
::
compiler-formula=**
::
:: event 4: hoon compiler source, compiling to event 2
::
compiler-source=*@t
::
:: event 5: arvo kernel source
::
arvo-source=*@t
::
:: events 6..n: main sequence with normal semantics
::
main-sequence=**
==
!= :_ main-sequence
::
:: activate the compiler gate. the product of this formula
:: is smaller than the formula. so you might think we should
:: save the gate itself rather than the formula producing it.
:: but we have to run the formula at runtime, to register jets.
::
:: as always, we have to use raw nock as we have no type.
:: the gate is in fact ++ride.
::
~> %slog.[0 leaf+"1-b"]
=+ ^= compiler-gate
.*(0 compiler-formula)
::
:: compile the compiler source, producing (pair span nock).
:: the compiler ignores its input so we use a trivial span.
::
~> %slog.[0 leaf+"1-c (compiling compiler, wait a few minutes)"]
=+ ^= compiler-tool
.*(compiler-gate [%9 2 %10 [6 %1 [%noun compiler-source]] %0 1])
::
:: switch to the second-generation compiler. we want to be
:: able to generate matching reflection nouns even if the
:: language changes -- the first-generation formula will
:: generate last-generation spans for `!>`, etc.
::
~> %slog.[0 leaf+"1-d"]
=. compiler-gate .*(0 +:compiler-tool)
::
:: get the span (type) of the kernel core, which is the context
:: of the compiler gate. we just compiled the compiler,
:: so we know the span (type) of the compiler gate. its
:: context is at tree address `+>` (ie, `+7` or Lisp `cddr`).
:: we use the compiler again to infer this trivial program.
::
~> %slog.[0 leaf+"1-e"]
=+ ^= kernel-span
-:.*(compiler-gate [%9 2 %10 [6 %1 [-.compiler-tool '+>']] %0 1])
::
:: compile the arvo source against the kernel core.
::
~> %slog.[0 leaf+"1-f"]
=+ ^= kernel-tool
.*(compiler-gate [%9 2 %10 [6 %1 [kernel-span arvo-source]] %0 1])
::
:: create the arvo kernel, whose subject is the kernel core.
::
~> %slog.[0 leaf+"1-g"]
.*(+>:compiler-gate +:kernel-tool)
^- pill:pill
::
:: sys: root path to boot system, `/~me/[desk]/now/sys`
::
@ -165,7 +28,7 @@
:: compiler-twig: compiler as hoon expression
::
~& %brass-parsing
=+ compiler-twig=(ream compiler-source)
=+ compiler-twig=(rain /sys/hoon/hoon compiler-source)
~& %brass-parsed
::
:: compiler-formula: compiler as nock formula
@ -180,22 +43,19 @@
::
:: boot-ova: startup events
::
=+ ^= boot-ova ^- (list *)
:~ boot-one
boot-two
compiler-formula
compiler-source
arvo-source
==
=/ boot-ova=(list)
:~ aeon:eden:part
boot:eden:part
compiler-formula
compiler-source
arvo-source
==
:: a pill is a 3-tuple of event-lists: [boot kernel userspace]
::
=/ bas=path (flop (tail (flop sys)))
:+ %pill %brass
:+ boot-ova
:~ :~ //arvo
%what
[/sys/hoon hoon/compiler-source]
[/sys/arvo hoon/arvo-source]
==
:~ (boot-ovum:pill compiler-source arvo-source)
(file-ovum2:pill bas)
==
[(file-ovum:pill bas) ~]

View File

@ -4,8 +4,7 @@
::
:: eg: |claz-invites ~marzod 1 10 %/example-invites/txt
::
/+ keygen
=, ethereum
/+ keygen, *ethereum
::
:- %say
|= $: [now=@da eny=@uvJ =beak]
@ -37,5 +36,5 @@
;: weld
(scow %p who) ","
(slag 1 (scow %q ticket)) ","
(address-to-hex:ethereum owner)
(address-to-hex owner)
==

View File

@ -38,7 +38,7 @@
=+((pars bek.arg) [who dez (opt-case caz) gem])
==
++ opt-case |=(a=case ?:(=(*case cas) a cas)) :: override
++ pars |=(a=beaky `[[who=ship dez=desk caz=case] *]`(need (de-beam:format a)))
++ pars |=(a=beaky `[[who=ship dez=desk caz=case] *]`(need (de-beam a)))
++ pars-src
|= syd=$@(desk beaky)
?@ syd syd

View File

@ -13,7 +13,7 @@
=rift
==
:- %helm-moon
^- (unit [=ship =udiff:point:able:jael])
^- (unit [=ship =udiff:point:jael])
=* our p.bec
=/ ran (clan:title our)
?: ?=([?(%earl %pawn)] ran)
@ -30,4 +30,4 @@
?. =(*^rift rift)
rift
+(.^(^rift j+/(scot %p our)/rift/(scot %da now)/(scot %p mon)))
`[mon *id:block:able:jael %rift rift]
`[mon *id:block:jael %rift rift]

View File

@ -14,7 +14,7 @@
public-key=pass
==
:- %helm-moon
^- (unit [=ship =udiff:point:able:jael])
^- (unit [=ship =udiff:point:jael])
=* our p.bec
=/ ran (clan:title our)
?: ?=([?(%earl %pawn)] ran)
@ -35,11 +35,11 @@
?. =(*pass public-key)
public-key
=/ cub (pit:nu:crub:crypto 512 (shaz (jam mon life eny)))
=/ =seed:able:jael
=/ =seed:jael
[mon life sec:ex:cub ~]
%- %- slog
:~ leaf+"moon: {(scow %p mon)}"
leaf+(scow %uw (jam seed))
==
pub:ex:cub
`[mon *id:block:able:jael %keys life 1 pass]
`[mon *id:block:jael %keys life 1 pass]

View File

@ -13,7 +13,7 @@
public-key=pass
==
:- %helm-moon
^- (unit [=ship =udiff:point:able:jael])
^- (unit [=ship =udiff:point:jael])
=* our p.bec
=/ ran (clan:title our)
?: ?=([?(%earl %pawn)] ran)
@ -34,11 +34,11 @@
?. =(*pass public-key)
public-key
=/ cub (pit:nu:crub:crypto 512 (shaz (jam mon life=1 eny)))
=/ =seed:able:jael
=/ =seed:jael
[mon 1 sec:ex:cub ~]
%- %- slog
:~ leaf+"moon: {(scow %p mon)}"
leaf+(scow %uw (jam seed))
==
pub:ex:cub
`[mon *id:block:able:jael %keys 1 1 pass]
`[mon *id:block:jael %keys 1 1 pass]

View File

@ -11,7 +11,7 @@
[[pax=path pot=$@(~ [v=@tas ~])] ~]
==
?~ pot
=+ bem=(need (de-beam:format pax))
=+ bem=(need (de-beam pax))
$(pot ~[?^(s.bem (rear s.bem) q.bem)])
:- %kiln-mount
[pax v.pot]

View File

@ -3,6 +3,7 @@
:::: /hoon/ivory/gen
::
/? 310
/+ pill
::
::::
!:
@ -12,73 +13,64 @@
~
==
:- %noun
:: sys: root path to boot system, `/~me/[desk]/now/sys`
::
^- pill:pill
=/ sys=path
?^ arg top.arg
/(scot %p p.bec)/[q.bec]/(scot %da now)/sys
:: compiler-source: hoon source file producing compiler, `sys/hoon`
=/ lib
(welp (flop (tail (flop sys))) /lib)
::
=/ compiler-source
.^(@t %cx (welp sys /hoon/hoon))
:: compiler-hoon: compiler as hoon expression
|^ =/ ver
=/ sub *(trap vase)
=. sub (build-sys sub %hoon)
=. sub (build-sys sub %arvo)
=. sub (build-sys sub %lull)
=. sub (build-sys sub %zuse)
=. sub (build-lib sub & %ethereum)
=. sub (build-lib sub & %azimuth)
(build-lib sub | %vere)
=/ nok !.
=> *[ver=(trap vase) ~]
!= q:$:ver
ivory/[nok ver ~]
::
:: Parsed with a static path for reproducibility.
++ build-sys
|= [sub=(trap vase) nam=term] ^- (trap vase)
~> %slog.[0 leaf+"ivory: building /sys/{(trip nam)}"]
(swat sub (rain /sys/[nam]/hoon .^(@t cx+(welp sys /[nam]/hoon))))
::
~& %ivory-parsing
=/ compiler-hoon (rain /sys/hoon/hoon compiler-source)
~& %ivory-parsed
:: arvo-source: hoon source file producing arvo kernel, `sys/arvo`
++ build-lib
|= [sub=(trap vase) imp=? nam=term] ^- (trap vase)
~> %slog.[0 leaf+"ivory: building /lib/{(trip nam)}"]
=/ hun=hoon
%+ mist /lib/[nam]/hoon
.^(@t cx+(welp lib /[nam]/hoon))
?. imp (swat sub hun)
(swel sub [%ktts nam hun])
:: +mist: +rain but skipping past ford runes
::
=/ arvo-source
.^(@t %cx (welp sys /arvo/hoon))
:: whole-hoon: arvo within compiler
::
:: Parsed with a static path for reproducibility.
::
=/ whole-hoon=hoon
:+ %tsgr compiler-hoon
:+ %tsgl (rain /sys/arvo/hoon arvo-source)
[%$ 7]
:: compile the whole schmeer
::
~& %ivory-compiling
=/ whole-formula
q:(~(mint ut %noun) %noun whole-hoon)
~& %ivory-compiled
:: zuse-ovo: standard library installation event
::
:: Arvo parses the %veer card contents with +rain;
:: we include a static path for reproducibility.
::
=/ zuse-ovo=ovum
:~ //arvo
%what
[/sys/hoon hoon/compiler-source]
[/sys/arvo hoon/arvo-source]
[/sys/lull hoon/.^(@ %cx (weld sys /lull/hoon))]
[/sys/zuse hoon/.^(@ %cx (weld sys /zuse/hoon))]
++ mist
|= [bon=path txt=@]
^- hoon
=+ vas=vast
~| bon
%+ scan (trip txt)
%- full
=; fud
(ifix [;~(plug gay fud) gay] tall:vas(wer bon))
%- star
;~ pose vul
%+ ifix [fas (just `@`10)]
(star ;~(less (just `@`10) next))
==
:: installed: Arvo gate (formal instance) with %zuse installed
:: +swel: +swat but with +slop
::
:: The :zuse-ovo event occurs at a defaulted date for reproducibility.
::
~& %zuse-installing
=/ installed
.* 0
:+ %7 whole-formula
[%9 2 %10 [6 %1 *@da zuse-ovo] %0 1]
~& %zuse-installed
:: our boot-ova is a list containing one massive formula:
::
:: We evaluate :whole-formula (for jet registration),
:: then ignore the result and produces :installed
::
=/ boot-ova=(list)
[[%7 whole-formula %1 installed] ~]
:: a pill is a 3-tuple of event-lists: [boot kernel userspace]
::
:: Our kernel event-list is ~, as we've already installed them.
:: Our userspace event-list is ~, as this pill must be compact.
::
[boot-ova ~ ~]
++ swel
|= [tap=(trap vase) gen=hoon]
^- (trap vase)
=/ gun (~(mint ut p:$:tap) %noun gen)
=> [tap=tap gun=gun]
|. ~+
=/ pro q:$:tap
[[%cell p.gun p:$:tap] [.*(pro q.gun) pro]]
--

View File

@ -1,7 +1,7 @@
:: Create a private key-file
::
/- *sole
/+ *generators
/+ *generators, ethereum
::
:- %ask
|= $: [now=@da eny=@uvJ bec=beak]
@ -26,6 +26,6 @@
%+ print leaf+" networking: 0x{(render-hex-bytes:ethereum 32 cry)}"
%+ print leaf+"ethereum public keys:"
::
=/ sed=seed:able:jael
=/ sed=seed:jael
[who life sec:ex:cub ~]
%- produce [%atom (scot %uw (jam sed))]

View File

@ -1,8 +0,0 @@
:: serve a notebook in your filesystem
::
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[name=term ~] ~]
==
:- %publish-action
[%serve name]

View File

@ -1,8 +0,0 @@
:: subscribe to a publish notebook
::
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[=ship name=term ~] ~]
==
:- %publish-action
[%subscribe ship name]

View File

@ -65,30 +65,13 @@
=< q
%^ spin
^- (list ovum)
:~ :~ //arvo
%what
[/sys/hoon hoon/compiler-src]
[/sys/arvo hoon/arvo-src]
==
:~ (boot-ovum:pill compiler-src arvo-src)
(file-ovum2:pill (flop (tail (flop sys))))
==
.*(0 arvo-formula)
|= [ovo=ovum ken=*]
[~ (slum ken [now ovo])]
::
:: boot-one: lifecycle formula (from +brass)
::
=/ boot-one
=> [boot-formula=** full-sequence=**]
!= =+ [state-gate main-sequence]=.*(full-sequence boot-formula)
|-
?@ main-sequence
state-gate
%= $
main-sequence +.main-sequence
state-gate .*(state-gate [%9 2 %10 [6 %1 -.main-sequence] %0 1])
==
::
:: kernel-formula
::
:: We evaluate :arvo-formula (for jet registration),
@ -106,7 +89,7 @@
:: boot-ova
::
=/ boot-ova=(list)
[boot-one boot-two kernel-formula ~]
[aeon:eden:part boot-two kernel-formula ~]
::
:: a pill is a 3-tuple of event-lists: [boot kernel userspace]
::
@ -114,6 +97,7 @@
:: Our userspace event-list is a list containing a full %clay
:: filesystem sync event.
::
:+ %pill %solid
:+ boot-ova ~
=/ bas (flop (tail (flop sys)))
[(file-ovum:pill bas) ~]

View File

@ -5,5 +5,5 @@
[%tang >timers< ~]
.^ (list [date=@da =duct])
%bx
(en-beam:format [p.bec %$ r.bec] /debug/timers)
(en-beam [p.bec %$ r.bec] /debug/timers)
==

View File

@ -1,4 +1,5 @@
/- *aquarium
/+ ethereum, azimuth
::
|%
::
@ -133,14 +134,14 @@
==
::
++ number-to-hash
|= =number:block:able:jael
|= =number:block:jael
^- @
?: (lth number launch:contracts:azimuth)
(cat 3 0x5364 (sub launch:contracts:azimuth number))
(cat 3 0x5363 (sub number launch:contracts:azimuth))
::
++ hash-to-number
|= =hash:block:able:jael
|= =hash:block:jael
(add launch:contracts:azimuth (div hash 0x1.0000))
::
++ logs-by-range
@ -156,8 +157,8 @@
logs.azi
::
++ logs-by-hash
|= =hash:block:able:jael
=/ =number:block:able:jael (hash-to-number hash)
|= =hash:block:jael
=/ =number:block:jael (hash-to-number hash)
(logs-by-range number number)
::
++ logs-to-json

View File

@ -1,145 +1,433 @@
/+ strandio
=, strand=strand:strandio
=, able:jael
|%
++ tract azimuth:contracts:azimuth
++ fetch-point
|= [url=@ta who=ship]
=/ m (strand ,point:azimuth)
^- form:m
=/ =request:rpc:ethereum
:+ %eth-call
=- [from=~ to=tract gas=~ price=~ value=~ data=-]
(encode-call:rpc:ethereum 'points(uint32)' [%uint `@`who]~)
[%label %latest]
;< jon=json bind:m (request-rpc url `'point' request)
=/ res=cord (so:dejs:format jon)
=/ =point:eth-noun:azimuth
(decode-results:abi:ethereum res point:eth-type:azimuth)
::
=/ =request:rpc:ethereum
:+ %eth-call
=- [from=~ to=tract gas=~ price=~ value=~ data=-]
(encode-call:rpc:ethereum 'rights(uint32)' [%uint `@`who]~)
[%label %latest]
;< jon=json bind:m (request-rpc url `'deed' request)
=/ res=cord (so:dejs:format jon)
=/ =deed:eth-noun:azimuth
(decode-results:abi:ethereum res deed:eth-type:azimuth)
::
(pure:m (point-from-eth:azimuth who point deed))
:: azimuth: constants and utilities
::
++ request-rpc
|= [url=@ta id=(unit @t) req=request:rpc:ethereum]
=/ m (strand ,json)
^- form:m
%+ (retry json) `10
=/ m (strand ,(unit json))
^- form:m
|^
=/ =request:http
:* method=%'POST'
url=url
header-list=['Content-Type'^'application/json' ~]
^= body
%- some %- as-octt:mimes:html
%- en-json:html
(request-to-json:rpc:ethereum id req)
/+ ethereum
::
=> => [azimuth-types ethereum-types .]
|%
+$ complete-ship
$: state=point
history=(list diff-point) ::TODO maybe block/event nr? :: newest first
keys=(map life pass)
==
::
++ fleet (map @p complete-ship)
::
++ eth-type
|%
++ point
:~ [%bytes-n 32] :: encryptionKey
[%bytes-n 32] :: authenticationKey
%bool :: hasSponsor
%bool :: active
%bool :: escapeRequested
%uint :: sponsor
%uint :: escapeRequestedTo
%uint :: cryptoSuiteVersion
%uint :: keyRevisionNumber
%uint :: continuityNumber
==
++ deed
:~ %address :: owner
%address :: managementProxy
%address :: spawnProxy
%address :: votingProxy
%address :: transferProxy
==
--
::
++ eth-noun
|%
+$ point
$: encryption-key=octs
authentication-key=octs
has-sponsor=?
active=?
escape-requested=?
sponsor=@ud
escape-to=@ud
crypto-suite=@ud
key-revision=@ud
continuity-number=@ud
==
+$ deed
$: owner=address
management-proxy=address
spawn-proxy=address
voting-proxy=address
transfer-proxy=address
==
--
::
++ function
|%
++ azimuth
$% [%points who=@p]
[%rights who=@p]
[%get-spawned who=@p]
[%dns-domains ind=@ud]
==
--
::
:: # diffs
::
++ update
$% [%full ships=(map ship point) dns=dnses heard=events]
[%difs dis=(list (pair event-id diff-azimuth))]
==
::
:: # constants
::
:: contract addresses
++ contracts mainnet-contracts
++ mainnet-contracts
|%
:: azimuth: data contract
::
++ azimuth
0x223c.067f.8cf2.8ae1.73ee.5caf.ea60.ca44.c335.fecb
::
++ ecliptic
0x6ac0.7b7c.4601.b5ce.11de.8dfe.6335.b871.c7c4.dd4d
::
++ linear-star-release
0x86cd.9cd0.992f.0423.1751.e376.1de4.5cec.ea5d.1801
::
++ conditional-star-release
0x8c24.1098.c3d3.498f.e126.1421.633f.d579.86d7.4aea
::
++ delegated-sending
0xf790.8ab1.f1e3.52f8.3c5e.bc75.051c.0565.aeae.a5fb
::
:: launch: block number of azimuth deploy
::
++ launch 6.784.800
::
:: public: block number of azimuth becoming independent
::
++ public 7.033.765
--
::
:: Testnet contract addresses
::
++ ropsten-contracts
|%
++ azimuth
0x308a.b6a6.024c.f198.b57e.008d.0ac9.ad02.1988.6579
::
++ ecliptic
0x8b9f.86a2.8921.d9c7.05b3.113a.755f.b979.e1bd.1bce
::
++ linear-star-release
0x1f8e.dd03.1ee4.1474.0aed.b39b.84fb.8f2f.66ca.422f
::
++ conditional-star-release
0x0
::
++ delegated-sending
0x3e8c.a510.354b.c2fd.bbd6.1502.52d9.3105.c9c2.7bbe
::
++ launch 4.601.630
++ public launch
--
::
:: ++ azimuth 0x863d.9c2e.5c4c.1335.96cf.ac29.d552.55f0.d0f8.6381 :: local bridge
:: hashes of ship event signatures
++ azimuth-events
|%
::
:: OwnerChanged(uint32,address)
++ owner-changed
0x16d0.f539.d49c.6cad.822b.767a.9445.bfb1.
cf7e.a6f2.a6c2.b120.a7ea.4cc7.660d.8fda
::
:: Activated(uint32)
++ activated
0xe74c.0380.9d07.69e1.b1f7.06cc.8414.258c.
d1f3.b6fe.020c.d15d.0165.c210.ba50.3a0f
::
:: Spawned(uint32,uint32)
++ spawned
0xb2d3.a6e7.a339.f5c8.ff96.265e.2f03.a010.
a854.1070.f374.4a24.7090.9644.1508.1546
::
:: EscapeRequested(uint32,uint32)
++ escape-requested
0xb4d4.850b.8f21.8218.141c.5665.cba3.79e5.
3e9b.b015.b51e.8d93.4be7.0210.aead.874a
::
:: EscapeCanceled(uint32,uint32)
++ escape-canceled
0xd653.bb0e.0bb7.ce83.93e6.24d9.8fbf.17cd.
a590.2c83.28ed.0cd0.9988.f368.90d9.932a
::
:: EscapeAccepted(uint32,uint32)
++ escape-accepted
0x7e44.7c9b.1bda.4b17.4b07.96e1.00bf.7f34.
ebf3.6dbb.7fe6.6549.0b1b.fce6.246a.9da5
::
:: LostSponsor(uint32,uint32)
++ lost-sponsor
0xd770.4f9a.2519.3dbd.0b0c.b4a8.09fe.ffff.
a7f1.9d1a.ae88.17a7.1346.c194.4482.10d5
::
:: ChangedKeys(uint32,bytes32,bytes32,uint32,uint32)
++ changed-keys
0xaa10.e7a0.117d.4323.f1d9.9d63.0ec1.69be.
bb3a.988e.8957.70e3.5198.7e01.ff54.23d5
::
:: BrokeContinuity(uint32,uint32)
++ broke-continuity
0x2929.4799.f1c2.1a37.ef83.8e15.f79d.d91b.
cee2.df99.d63c.d1c1.8ac9.68b1.2951.4e6e
::
:: ChangedSpawnProxy(uint32,address)
++ changed-spawn-proxy
0x9027.36af.7b3c.efe1.0d9e.840a.ed0d.687e.
35c8.4095.122b.2505.1a20.ead8.866f.006d
::
:: ChangedTransferProxy(uint32,address)
++ changed-transfer-proxy
0xcfe3.69b7.197e.7f0c.f067.93ae.2472.a9b1.
3583.fecb.ed2f.78df.a14d.1f10.796b.847c
::
:: ChangedManagementProxy(uint32,address)
++ changed-management-proxy
0xab9c.9327.cffd.2acc.168f.afed.be06.139f.
5f55.cb84.c761.df05.e051.1c25.1e2e.e9bf
::
:: ChangedVotingProxy(uint32,address)
++ changed-voting-proxy
0xcbd6.269e.c714.57f2.c7b1.a227.74f2.46f6.
c5a2.eae3.795e.d730.0db5.1768.0c61.c805
::
:: ChangedDns(string,string,string)
++ changed-dns
0xfafd.04ad.e1da.ae2e.1fdb.0fc1.cc6a.899f.
d424.063e.d5c9.2120.e67e.0730.53b9.4898
--
--
::
:: logic
::
|%
++ pass-from-eth
|= [enc=octs aut=octs sut=@ud]
^- pass
%^ cat 3 'b'
?. &(=(1 sut) =(p.enc 32) =(p.aut 32))
(cat 8 0 0)
(cat 8 q.aut q.enc)
::
++ point-from-eth
|= [who=@p point:eth-noun deed:eth-noun]
^- point
::
:: ownership
::
:+ :* owner
management-proxy
voting-proxy
transfer-proxy
==
::
:: network state
::
?. active ~
:- ~
:* key-revision
::
(pass-from-eth encryption-key authentication-key crypto-suite)
::
continuity-number
::
[has-sponsor `@p`sponsor]
::
?. escape-requested ~
``@p`escape-to
==
;< ~ bind:m (send-request:strandio request)
;< rep=(unit client-response:iris) bind:m
take-maybe-response:strandio
?~ rep
(pure:m ~)
(parse-response u.rep)
::
++ parse-response
|= =client-response:iris
=/ m (strand ,(unit json))
^- form:m
?> ?=(%finished -.client-response)
?~ full-file.client-response
(pure:m ~)
=/ body=@t q.data.u.full-file.client-response
=/ jon=(unit json) (de-json:html body)
?~ jon
(pure:m ~)
=, dejs-soft:format
=/ array=(unit (list response:rpc:jstd))
((ar parse-one-response) u.jon)
?~ array
=/ res=(unit response:rpc:jstd) (parse-one-response u.jon)
?~ res
(strand-fail:strandio %request-rpc-parse-error >id< ~)
?: ?=(%error -.u.res)
(strand-fail:strandio %request-rpc-error >id< >+.res< ~)
?. ?=(%result -.u.res)
(strand-fail:strandio %request-rpc-fail >u.res< ~)
(pure:m `res.u.res)
(strand-fail:strandio %request-rpc-batch >%not-implemented< ~)
:: (pure:m `[%batch u.array])
:: spawn state
::
++ parse-one-response
|= =json
^- (unit response:rpc:jstd)
=/ res=(unit [@t ^json])
%. json
=, dejs-soft:format
(ot id+so result+some ~)
?^ res `[%result u.res]
~| parse-one-response=json
:+ ~ %error %- need
%. json
=, dejs-soft:format
(ot id+so error+(ot code+no message+so ~) ~)
?. ?=(?(%czar %king) (clan:title who)) ~
:- ~
:* spawn-proxy
~ ::TODO call getSpawned to fill this
==
::
++ event-log-to-point-diff
=, azimuth-events
=, abi:ethereum
|= log=event-log:rpc:ethereum
^- (unit (pair ship diff-point))
~? ?=(~ mined.log) %processing-unmined-event
::
?: =(i.topics.log owner-changed)
=/ [who=@ wer=address]
(decode-topics t.topics.log ~[%uint %address])
`[who %owner wer]
::
?: =(i.topics.log activated)
=/ who=@
(decode-topics t.topics.log ~[%uint])
`[who %activated who]
::
?: =(i.topics.log spawned)
=/ [pre=@ who=@]
(decode-topics t.topics.log ~[%uint %uint])
`[pre %spawned who]
::
?: =(i.topics.log escape-requested)
=/ [who=@ wer=@]
(decode-topics t.topics.log ~[%uint %uint])
`[who %escape `wer]
::
?: =(i.topics.log escape-canceled)
=/ who=@ (decode-topics t.topics.log ~[%uint])
`[who %escape ~]
::
?: =(i.topics.log escape-accepted)
=/ [who=@ wer=@]
(decode-topics t.topics.log ~[%uint %uint])
`[who %sponsor & wer]
::
?: =(i.topics.log lost-sponsor)
=/ [who=@ pos=@]
(decode-topics t.topics.log ~[%uint %uint])
`[who %sponsor | pos]
::
?: =(i.topics.log changed-keys)
=/ who=@ (decode-topics t.topics.log ~[%uint])
=/ [enc=octs aut=octs sut=@ud rev=@ud]
%+ decode-results data.log
~[[%bytes-n 32] [%bytes-n 32] %uint %uint]
`[who %keys rev (pass-from-eth enc aut sut)]
::
?: =(i.topics.log broke-continuity)
=/ who=@ (decode-topics t.topics.log ~[%uint])
=/ num=@ (decode-results data.log ~[%uint])
`[who %continuity num]
::
?: =(i.topics.log changed-management-proxy)
=/ [who=@ sox=address]
(decode-topics t.topics.log ~[%uint %address])
`[who %management-proxy sox]
::
?: =(i.topics.log changed-voting-proxy)
=/ [who=@ tox=address]
(decode-topics t.topics.log ~[%uint %address])
`[who %voting-proxy tox]
::
?: =(i.topics.log changed-spawn-proxy)
=/ [who=@ sox=address]
(decode-topics t.topics.log ~[%uint %address])
`[who %spawn-proxy sox]
::
?: =(i.topics.log changed-transfer-proxy)
=/ [who=@ tox=address]
(decode-topics t.topics.log ~[%uint %address])
`[who %transfer-proxy tox]
::
:: warn about unimplemented events, but ignore
:: the ones we know are harmless.
~? ?! .= i.topics.log
:: OwnershipTransferred(address,address)
0x8be0.079c.5316.5914.1344.cd1f.d0a4.f284.
1949.7f97.22a3.daaf.e3b4.186f.6b64.57e0
[%unimplemented-event i.topics.log]
~
::
++ apply-point-diff
|= [pot=point dif=diff-point]
^- point
?- -.dif
%full new.dif
::
%activated
%_ pot
net `[0 0 0 &^(^sein:title who.dif) ~]
kid ?. ?=(?(%czar %king) (clan:title who.dif)) ~
`[0x0 ~]
==
::
:: ownership
::
%owner pot(owner.own new.dif)
%transfer-proxy pot(transfer-proxy.own new.dif)
%management-proxy pot(management-proxy.own new.dif)
%voting-proxy pot(voting-proxy.own new.dif)
::
:: networking
::
?(%keys %continuity %sponsor %escape)
?> ?=(^ net.pot)
?- -.dif
%keys
pot(life.u.net life.dif, pass.u.net pass.dif)
::
%sponsor
%= pot
sponsor.u.net new.dif
escape.u.net ?:(has.new.dif ~ escape.u.net.pot)
==
::
%continuity pot(continuity-number.u.net new.dif)
%escape pot(escape.u.net new.dif)
==
::
:: spawning
::
?(%spawned %spawn-proxy)
?> ?=(^ kid.pot)
?- -.dif
%spawned
=- pot(spawned.u.kid -)
(~(put in spawned.u.kid.pot) who.dif)
::
%spawn-proxy pot(spawn-proxy.u.kid new.dif)
==
==
::
++ parse-id
|= id=@t
^- azimuth:function
|^
~| id
%+ rash id
;~ pose
(function %points 'points' shipname)
(function %get-spawned 'getSpawned' shipname)
(function %dns-domains 'dnsDomains' dem:ag)
==
::
++ function
|* [tag=@tas fun=@t rul=rule]
;~(plug (cold tag (jest fun)) (ifix [pal par] rul))
::
++ shipname
;~(pfix sig fed:ag)
--
::
++ retry
|* result=mold
|= [crash-after=(unit @ud) computation=_*form:(strand (unit result))]
=/ m (strand ,result)
=| try=@ud
|- ^- form:m
=* loop $
?: =(crash-after `try)
(strand-fail:strandio %retry-too-many ~)
;< ~ bind:m (backoff:strandio try ~m1)
;< res=(unit result) bind:m computation
?^ res
(pure:m u.res)
loop(try +(try))
::
++ get-latest-block
|= url=@ta
=/ m (strand ,block)
^- form:m
;< =json bind:m (request-rpc url `'block number' %eth-block-number ~)
(get-block-by-number url (parse-eth-block-number:rpc:ethereum json))
::
++ get-block-by-number
|= [url=@ta =number:block]
=/ m (strand ,block)
^- form:m
|^
;< =json bind:m
(request-rpc url `'block by number' %eth-get-block-by-number number |)
=/ =block (parse-block json)
?. =(number number.id.block)
(strand-fail:strandio %reorg-detected >number< >block< ~)
(pure:m block)
::
++ parse-block
|= =json
^- block
=< [[&1 &2] |2]
^- [@ @ @]
~| json
%. json
=, dejs:format
%- ot
:~ hash+parse-hex-result:rpc:ethereum
number+parse-hex-result:rpc:ethereum
'parentHash'^parse-hex-result:rpc:ethereum
++ function-to-call
|%
++ azimuth
|= cal=azimuth:function
^- [id=@t dat=call-data:rpc:ethereum]
?- -.cal
%points
:- (crip "points({(scow %p who.cal)})")
['points(uint32)' ~[uint+`@`who.cal]]
::
%rights
:- (crip "rights({(scow %p who.cal)})")
['rights(uint32)' ~[uint+`@`who.cal]]
::
%get-spawned
:- (crip "getSpawned({(scow %p who.cal)})")
['getSpawned(uint32)' ~[uint+`@`who.cal]]
::
%dns-domains
:- (crip "dnsDomains({(scow %ud ind.cal)})")
['dnsDomains(uint256)' ~[uint+ind.cal]]
==
--
--

146
pkg/arvo/lib/azimuthio.hoon Normal file
View File

@ -0,0 +1,146 @@
/- rpc=json-rpc
/+ ethereum, azimuth, strandio
=, strand=strand:strandio
=, jael
|%
++ tract azimuth:contracts:azimuth
++ fetch-point
|= [url=@ta who=ship]
=/ m (strand ,point:azimuth)
^- form:m
=/ =request:rpc:ethereum
:+ %eth-call
=- [from=~ to=tract gas=~ price=~ value=~ data=-]
(encode-call:rpc:ethereum 'points(uint32)' [%uint `@`who]~)
[%label %latest]
;< jon=json bind:m (request-rpc url `'point' request)
=/ res=cord (so:dejs:format jon)
=/ =point:eth-noun:azimuth
(decode-results:abi:ethereum res point:eth-type:azimuth)
::
=/ =request:rpc:ethereum
:+ %eth-call
=- [from=~ to=tract gas=~ price=~ value=~ data=-]
(encode-call:rpc:ethereum 'rights(uint32)' [%uint `@`who]~)
[%label %latest]
;< jon=json bind:m (request-rpc url `'deed' request)
=/ res=cord (so:dejs:format jon)
=/ =deed:eth-noun:azimuth
(decode-results:abi:ethereum res deed:eth-type:azimuth)
::
(pure:m (point-from-eth:azimuth who point deed))
::
++ request-rpc
|= [url=@ta id=(unit @t) req=request:rpc:ethereum]
=/ m (strand ,json)
^- form:m
%+ (retry json) `10
=/ m (strand ,(unit json))
^- form:m
|^
=/ =request:http
:* method=%'POST'
url=url
header-list=['Content-Type'^'application/json' ~]
^= body
%- some %- as-octt:mimes:html
%- en-json:html
(request-to-json:rpc:ethereum id req)
==
;< ~ bind:m (send-request:strandio request)
;< rep=(unit client-response:iris) bind:m
take-maybe-response:strandio
?~ rep
(pure:m ~)
(parse-response u.rep)
::
++ parse-response
|= =client-response:iris
=/ m (strand ,(unit json))
^- form:m
?> ?=(%finished -.client-response)
?~ full-file.client-response
(pure:m ~)
=/ body=@t q.data.u.full-file.client-response
=/ jon=(unit json) (de-json:html body)
?~ jon
(pure:m ~)
=, dejs-soft:format
=/ array=(unit (list response:rpc))
((ar parse-one-response) u.jon)
?~ array
=/ res=(unit response:rpc) (parse-one-response u.jon)
?~ res
(strand-fail:strandio %request-rpc-parse-error >id< ~)
?: ?=(%error -.u.res)
(strand-fail:strandio %request-rpc-error >id< >+.res< ~)
?. ?=(%result -.u.res)
(strand-fail:strandio %request-rpc-fail >u.res< ~)
(pure:m `res.u.res)
(strand-fail:strandio %request-rpc-batch >%not-implemented< ~)
:: (pure:m `[%batch u.array])
::
++ parse-one-response
|= =json
^- (unit response:rpc)
=/ res=(unit [@t ^json])
%. json
=, dejs-soft:format
(ot id+so result+some ~)
?^ res `[%result u.res]
~| parse-one-response=json
:+ ~ %error %- need
%. json
=, dejs-soft:format
(ot id+so error+(ot code+no message+so ~) ~)
--
::
++ retry
|* result=mold
|= [crash-after=(unit @ud) computation=_*form:(strand (unit result))]
=/ m (strand ,result)
=| try=@ud
|- ^- form:m
=* loop $
?: =(crash-after `try)
(strand-fail:strandio %retry-too-many ~)
;< ~ bind:m (backoff:strandio try ~m1)
;< res=(unit result) bind:m computation
?^ res
(pure:m u.res)
loop(try +(try))
::
++ get-latest-block
|= url=@ta
=/ m (strand ,block)
^- form:m
;< =json bind:m (request-rpc url `'block number' %eth-block-number ~)
(get-block-by-number url (parse-eth-block-number:rpc:ethereum json))
::
++ get-block-by-number
|= [url=@ta =number:block]
=/ m (strand ,block)
^- form:m
|^
;< =json bind:m
(request-rpc url `'block by number' %eth-get-block-by-number number |)
=/ =block (parse-block json)
?. =(number number.id.block)
(strand-fail:strandio %reorg-detected >number< >block< ~)
(pure:m block)
::
++ parse-block
|= =json
^- block
=< [[&1 &2] |2]
^- [@ @ @]
~| json
%. json
=, dejs:format
%- ot
:~ hash+parse-hex-result:rpc:ethereum
number+parse-hex-result:rpc:ethereum
'parentHash'^parse-hex-result:rpc:ethereum
==
--
--

View File

@ -1,133 +0,0 @@
:: |base64: flexible base64 encoding for little-endian atoms
::
:: pad: include padding when encoding, require when decoding
:: url: use url-safe characters '-' for '+' and '_' for '/'
::
::
=+ [pad=& url=|]
|%
::
+$ byte @D
+$ word24 @
::
++ div-ceil
:: divide, rounding up.
|= [x=@ y=@] ^- @
?: =(0 (mod x y))
(div x y)
+((div x y))
::
++ explode-bytes
:: Explode a bytestring into list of bytes. Result is in LSB order.
|= =octs ^- (list byte)
=/ atom-byte-width (met 3 q.octs)
=/ leading-zeros (sub p.octs atom-byte-width)
(weld (reap leading-zeros 0) (rip 3 q.octs))
::
++ explode-words
:: Explode a bytestring to words of bit-width `wid`. Result is in LSW order.
|= [wid=@ =octs]
^- (list @)
=/ atom-bit-width (met 0 q.octs)
=/ octs-bit-width (mul 8 p.octs)
=/ atom-word-width (div-ceil atom-bit-width wid)
=/ rslt-word-width (div-ceil octs-bit-width wid)
=/ pad (sub rslt-word-width atom-word-width)
=/ x (rip [0 wid] q.octs)
%+ weld x
(reap pad 0)
::
:: +en:base64: encode +octs to base64 cord
::
:: Encode an `octs` into a base64 string.
::
:: First, we break up the input into a list of 24-bit words. The input
:: might not be a multiple of 24-bits, so we add 0-2 padding bytes at
:: the end (to the least-significant side, with a left-shift).
::
:: Then, we encode each block into four base64 characters.
::
:: Finally we remove the padding that we added at the beginning: for
:: each byte that was added, we replace one character with an = (unless
:: `pad` is false, in which case we just remove the extra characters).
::
++ en
^- $-(octs cord)
::
=/ cha
?: url
'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_'
'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/'
::
|^ |= bs=octs ^- cord
=/ [padding=@ blocks=(list word24)]
(octs-to-blocks bs)
(crip (flop (unpad padding (encode-blocks blocks))))
::
++ octs-to-blocks
|= bs=octs ^- [padding=@ud (list word24)]
=/ padding=@ud (~(dif fo 3) 0 p.bs)
=/ padded=octs [(add padding p.bs) (lsh [3 padding] (rev 3 bs))]
[padding (explode-words 24 padded)]
::
++ unpad
|= [extra=@ t=tape] ^- tape
=/ without (slag extra t)
?. pad without
(weld (reap extra '=') without)
::
++ encode-blocks
|= ws=(list word24) ^- tape
(zing (turn ws encode-block))
::
++ encode-block
|= w=word24 ^- tape
=/ a (cut 3 [(cut 0 [0 6] w) 1] cha)
=/ b (cut 3 [(cut 0 [6 6] w) 1] cha)
=/ c (cut 3 [(cut 0 [12 6] w) 1] cha)
=/ d (cut 3 [(cut 0 [18 6] w) 1] cha)
~[a b c d]
--
::
:: +de:base64: decode base64 cord to (unit @)
::
++ de
|= a=cord
^- (unit octs)
(rush a parse)
:: +parse:base64: parse base64 cord to +octs
::
++ parse
=< ^- $-(nail (like octs))
%+ sear reduce
;~ plug
%- plus ;~ pose
(cook |=(a=@ (sub a 'A')) (shim 'A' 'Z'))
(cook |=(a=@ (sub a 'G')) (shim 'a' 'z'))
(cook |=(a=@ (add a 4)) (shim '0' '9'))
(cold 62 (just ?:(url '-' '+')))
(cold 63 (just ?:(url '_' '/')))
==
(stun 0^2 (cold %0 tis))
==
|%
:: +reduce:parse:base64: reduce, measure, and swap base64 digits
::
++ reduce
|= [dat=(list @) dap=(list @)]
^- (unit octs)
=/ lat (lent dat)
=/ lap (lent dap)
=/ dif (~(dif fo 4) 0 lat)
?: &(pad !=(dif lap))
:: padding required and incorrect
~&(%base-64-padding-err-one ~)
?: &(!pad !=(0 lap))
:: padding not required but present
~&(%base-64-padding-err-two ~)
=/ len (sub (mul 3 (div (add lat dif) 4)) dif)
:+ ~ len
%+ swp 3
(rep [0 6] (flop (weld dat (reap dif 0))))
--
--

View File

@ -1,51 +0,0 @@
/- sur=chat-hook
^?
=< [sur .]
=, sur
|%
::
++ enjs
|%
++ update
|= upd=^update
=, enjs:format
^- json
%+ frond %chat-hook-update
%- pairs
%+ turn ~(tap by synced.upd)
|= [pax=^path shp=^ship]
^- [cord json]
[(spat pax) s+(scot %p shp)]
--
++ dejs
|%
::
++ action
|= jon=json
^- ^action
=, dejs:format
=< (parse-json jon)
|%
::
++ parse-json
%- of
:~ [%add-owned add-owned]
[%add-synced add-synced]
[%remove pa]
==
::
++ add-owned
%- ot
:~ [%path pa]
[%allow-history bo]
==
::
++ add-synced
%- ot
:~ [%ship (su ;~(pfix sig fed:ag))]
[%path pa]
[%ask-history bo]
==
--
--
--

View File

@ -1,225 +0,0 @@
/- sur=chat-store
^?
=< [sur .]
=, sur
|%
++ enjs
=, enjs:format
|%
::
++ letter
|= =^letter
^- json
?- -.letter
%text
(frond %text s+text.letter)
::
%me
(frond %me s+narrative.letter)
::
%url
(frond %url s+url.letter)
::
%code
%+ frond %code
%- pairs
:- [%expression s+expression.letter]
:_ ~
:- %output
:: virtualize output rendering, +tank:enjs:format might crash
::
=/ result=(each (list json) tang)
(mule |.((turn output.letter tank)))
?- -.result
%& a+p.result
%| a+[a+[%s '[[output rendering error]]']~]~
==
==
::
++ envelope
|= =^envelope
^- json
%- pairs
:~ [%uid s+(scot %uv uid.envelope)]
[%number (numb number.envelope)]
[%author (ship author.envelope)]
[%when (time when.envelope)]
[%letter (letter letter.envelope)]
==
::
++ config
|= =^config
^- json
%- pairs
:~ [%length (numb length.config)]
[%read (numb read.config)]
==
::
++ update
|= upd=^update
^- json
%+ frond %chat-update
%- pairs
:_ ~
?- -.upd
%initial
:- %initial
%- pairs
%+ turn ~(tap by inbox.upd)
|= [pax=^path =mailbox]
^- [cord json]
:- (spat pax)
%- pairs
:~ [%envelopes [%a (turn envelopes.mailbox envelope)]]
[%config (config config.mailbox)]
==
::
%message
:- %message
%- pairs
:~ [%path (path path.upd)]
[%envelope (envelope envelope.upd)]
==
::
%messages
:- %messages
%- pairs
:~ [%path (path path.upd)]
[%start (numb start.upd)]
[%end (numb end.upd)]
[%envelopes [%a (turn envelopes.upd envelope)]]
==
::
%read
[%read (pairs [%path (path path.upd)]~)]
::
%create
[%create (pairs [%path (path path.upd)]~)]
::
%delete
[%delete (pairs [%path (path path.upd)]~)]
::
%keys
:- %keys
:- %a
%+ turn ~(tap by keys.upd)
|= pax=^path (path pax)
==
--
++ dejs
=, dejs:format
|%
::
++ action
|= jon=json
^- ^action
=< (parse-json jon)
|%
++ parse-json
%- of
:~ [%create create]
[%delete delete]
[%message message]
[%messages messages]
[%read read]
==
::
++ create
(ot [%path pa]~)
::
++ delete
(ot [%path pa]~)
::
++ message
%- ot
:~ [%path pa]
[%envelope envelope]
==
::
++ messages
%- ot
:~ [%path pa]
[%envelopes (ar envelope)]
==
::
++ read
(ot [%path pa] ~)
::
++ envelope
%- ot
:~ [%uid serial]
[%number ni]
[%author (su ;~(pfix sig fed:ag))]
[%when di]
[%letter letter]
==
::
++ letter
%- of
:~ [%text so]
[%url so]
[%code eval]
[%me so]
==
::
++ serial
^- $-(json ^serial)
(cu (cury slav %uv) so)
::
++ re :: recursive reparsers
|* [gar=* sef=_|.(fist:dejs-soft:format)]
|= jon=json
^- (unit _gar)
=- ~! gar ~! (need -) -
((sef) jon)
::
++ dank :: tank
^- $-(json (unit tank))
=, ^? dejs-soft:format
%+ re *tank |. ~+
%- of :~
leaf+sa
palm+(ot style+(ot mid+sa cap+sa open+sa close+sa ~) lines+(ar dank) ~)
rose+(ot style+(ot mid+sa open+sa close+sa ~) lines+(ar dank) ~)
==
:: %exp speech
++ eval
::: extract contents of an %exp speech, evaluating
::: the {exp} if there is no {res} yet.
::
|= a=json
^- [cord (list tank)]
=, ^? dejs-soft:format
=+ exp=((ot expression+so ~) a)
%- need
?~ exp [~ '' ~]
:+ ~ u.exp
::NOTE when sending, if output is an empty list, chat-store will evaluate
(fall ((ot output+(ar dank) ~) a) ~)
::
--
--
::
++ eval
|= [=bowl:gall =hoon]
^- (list tank)
=/ fowl=[our=@p now=@da eny=@uvJ]
:+ our.bowl
now.bowl
(shaz (cat 3 (mix [now eny]:bowl) %eny))
::
=/ subject [fowl ..zuse]
=/ minted=(each [=type =nock] (list tank))
%- mule |.
(~(mint ut -:!>(subject)) %noun hoon)
?: ?=(%| -.minted) p.minted
=/ =toon
(mock [subject nock.p.minted] |=(^ ~))
?- -.toon
%0 [(sell type.p.minted p.toon) ~]
%1 :- leaf+".^ unsupported in chat eval"
(turn ;;((list path) p.toon) smyt)
%2 [leaf+"crash!" p.toon]
==
--

View File

@ -1,56 +0,0 @@
/- sur=chat-view, *rw-security
/+ group-store
^?
=< [sur .]
=, sur
|%
++ dejs
|%
++ action
|= jon=json
^- ^action
=, dejs:format
=< (parse-json jon)
|%
++ parse-json
%- of
:~ [%create create]
[%delete delete]
[%join join]
[%groupify groupify]
[%invite invite]
==
::
++ create
%- ot
:~ [%title so]
[%description so]
[%app-path pa]
[%group-path pa]
[%policy policy:dejs:group-store]
[%members (as (su ;~(pfix sig fed:ag)))]
[%allow-history bo]
[%managed bo]
==
::
++ delete
(ot [%app-path pa]~)
::
++ join
%- ot
:~ [%ship (su ;~(pfix sig fed:ag))]
[%app-path pa]
[%ask-history bo]
==
::
++ groupify
=- (ot [%app-path pa] [%existing -] ~)
(mu (ot [%group-path pa] [%inclusive bo] ~))
++ invite
%- ot
:~ app-path+pa
ships+(as (su ;~(pfix sig fed:ag)))
==
--
--
--

View File

@ -1,8 +1,7 @@
:: claz: call data generation
::
/- *claz
::
=, ethereum
/+ *ethereum, azimuth
::
|%
++ read-invites ::TODO lib

View File

@ -1,5 +1,5 @@
/- *contact-view, *contact-hook
/+ base64, group-store, resource
/+ group-store, resource
|%
++ nu :: parse number as hex
|= jon=json
@ -222,7 +222,7 @@
?- -.avatar
%url avatar
%octt
=. octs.avatar (need (de:base64 q.octs.avatar))
=. octs.avatar (need (de:base64:mimes:html q.octs.avatar))
avatar
==
::

866
pkg/arvo/lib/ethereum.hoon Normal file
View File

@ -0,0 +1,866 @@
:: ethereum: utilities
::
=, ethereum-types
|%
:: deriving and using ethereum keys
::
++ key
|%
++ address-from-pub
=, keccak:crypto
|= pub=@
%+ end [3 20]
%+ keccak-256 64
(rev 3 64 pub)
::
++ address-from-prv
(cork pub-from-prv address-from-pub)
::
++ pub-from-prv
=, secp256k1:secp:crypto
|= prv=@
%- serialize-point
(priv-to-pub prv)
::
++ sign-transaction
=, crypto
|= [tx=transaction:rpc pk=@]
^- @ux
:: hash the raw transaction data
=/ hash=@
=/ dat=@
%- encode-atoms:rlp
:: with v=chain-id, r=0, s=0
tx(chain-id [chain-id.tx 0 0 ~])
=+ wid=(met 3 dat)
%- keccak-256:keccak
[wid (rev 3 wid dat)]
:: sign transaction hash with private key
=+ (ecdsa-raw-sign:secp256k1:secp hash pk)
:: complete transaction is raw data, with r and s
:: taken from the signature, and v as per eip-155
%- encode-atoms:rlp
tx(chain-id [:(add (mul chain-id.tx 2) 35 v) r s ~])
--
::
:: rlp en/decoding
::NOTE https://github.com/ethereum/wiki/wiki/RLP
::
++ rlp
|%
::NOTE rlp encoding doesn't really care about leading zeroes,
:: but because we need to disinguish between no-bytes zero
:: and one-byte zero (and also empty list) we end up with
:: this awful type...
+$ item
$% [%l l=(list item)]
[%b b=byts]
==
:: +encode-atoms: encode list of atoms as a %l of %b items
::
++ encode-atoms
|= l=(list @)
^- @
%+ encode %l
%+ turn l
|=(a=@ b+[(met 3 a) a])
::
++ encode
|= in=item
|^ ^- @
?- -.in
%b
?: &(=(1 wid.b.in) (lte dat.b.in 0x7f))
dat.b.in
=- (can 3 ~[b.in [(met 3 -) -]])
(encode-length wid.b.in 0x80)
::
%l
=/ out=@
%+ roll l.in
|= [ni=item en=@]
(cat 3 (encode ni) en)
%^ cat 3 out
(encode-length (met 3 out) 0xc0)
==
::
++ encode-length
|= [len=@ off=@]
?: (lth len 56) (add len off)
=- (cat 3 len -)
:(add (met 3 len) off 55)
--
:: +decode-atoms: decode expecting a %l of %b items, producing atoms within
::
++ decode-atoms
|= dat=@
^- (list @)
=/ i=item (decode dat)
~| [%unexpected-data i]
?> ?=(%l -.i)
%+ turn l.i
|= i=item
~| [%unexpected-list i]
?> ?=(%b -.i)
dat.b.i
::
++ decode
|= dat=@
^- item
=/ bytes=(list @) (flop (rip 3 dat))
=? bytes ?=(~ bytes) ~[0]
|^ item:decode-head
::
++ decode-head
^- [done=@ud =item]
?~ bytes
~| %rlp-unexpected-end
!!
=* byt i.bytes
:: byte in 0x00-0x79 range encodes itself
::
?: (lte byt 0x79)
:- 1
[%b 1^byt]
:: byte in 0x80-0xb7 range encodes string length
::
?: (lte byt 0xb7)
=+ len=(sub byt 0x80)
:- +(len)
:- %b
len^(get-value 1 len)
:: byte in 0xb8-0xbf range encodes string length length
::
?: (lte byt 0xbf)
=+ led=(sub byt 0xb7)
=+ len=(get-value 1 led)
:- (add +(led) len)
:- %b
len^(get-value +(led) len)
:: byte in 0xc0-f7 range encodes list length
::
?: (lte byt 0xf7)
=+ len=(sub byt 0xc0)
:- +(len)
:- %l
%. len
decode-list(bytes (slag 1 `(list @)`bytes))
:: byte in 0xf8-ff range encodes list length length
::
?: (lte byt 0xff)
=+ led=(sub byt 0xf7)
=+ len=(get-value 1 led)
:- (add +(led) len)
:- %l
%. len
decode-list(bytes (slag +(led) `(list @)`bytes))
~| [%rip-not-bloq-3 `@ux`byt]
!!
::
++ decode-list
|= rem=@ud
^- (list item)
?: =(0 rem) ~
=+ ^- [don=@ud =item] ::TODO =/
decode-head
:- item
%= $
rem (sub rem don)
bytes (slag don bytes)
==
::
++ get-value
|= [at=@ud to=@ud]
^- @
(rep 3 (flop (swag [at to] bytes)))
--
--
::
:: abi en/decoding
::NOTE https://solidity.readthedocs.io/en/develop/abi-spec.html
::
++ abi
=> |%
:: solidity types. integer bitsizes ignored
++ etyp
$@ $? :: static
%address %bool
%int %uint
%real %ureal
:: dynamic
%bytes %string
==
$% :: static
[%bytes-n n=@ud]
:: dynamic
[%array-n t=etyp n=@ud]
[%array t=etyp]
==
::
:: solidity-style typed data. integer bitsizes ignored
++ data
$% [%address p=address]
[%string p=tape]
[%bool p=?]
[%int p=@sd]
[%uint p=@ud]
[%real p=@rs]
[%ureal p=@urs]
[%array-n p=(list data)]
[%array p=(list data)]
[%bytes-n p=octs] ::TODO just @, because context knows length?
[%bytes p=octs]
==
--
=, mimes:html
|%
:: encoding
::
++ encode-args
:: encode list of arguments.
::
|= das=(list data)
^- tape
(encode-data [%array-n das])
::
++ encode-data
:: encode typed data into ABI bytestring.
::
|= dat=data
^- tape
?+ -.dat
~| [%unsupported-type -.dat]
!!
::
%array-n
:: enc(X) = head(X[0]) ... head(X[k-1]) tail(X[0]) ... tail(X[k-1])
:: where head and tail are defined for X[i] being of a static type as
:: head(X[i]) = enc(X[i]) and tail(X[i]) = "" (the empty string), or as
:: head(X[i]) = enc(len( head(X[0])..head(X[k-1])
:: tail(X[0])..tail(X[i-1]) ))
:: and tail(X[i]) = enc(X[i]) otherwise.
::
:: so: if it's a static type, data goes in the head. if it's a dynamic
:: type, a reference goes into the head and data goes into the tail.
::
:: in the head, we first put a placeholder where references need to go.
=+ hol=(reap 64 'x')
=/ hes=(list tape)
%+ turn p.dat
|= d=data
?. (is-dynamic-type d) ^$(dat d)
hol
=/ tas=(list tape)
%+ turn p.dat
|= d=data
?. (is-dynamic-type d) ""
^$(dat d)
:: once we know the head and tail, we can fill in the references in head.
=- (weld nes `tape`(zing tas))
^- [@ud nes=tape]
=+ led=(lent (zing hes))
%+ roll hes
|= [t=tape i=@ud nes=tape]
:- +(i)
:: if no reference needed, just put the data.
?. =(t hol) (weld nes t)
:: calculate byte offset of data we need to reference.
=/ ofs=@ud
=- (div - 2) :: two hex digits per byte.
%+ add led :: count head, and
%- lent %- zing :: count all tail data
(scag i tas) :: preceding ours.
=+ ref=^$(dat [%uint ofs])
:: shouldn't hit this unless we're sending over 2gb of data?
~| [%weird-ref-lent (lent ref)]
?> =((lent ref) (lent hol))
(weld nes ref)
::
%array :: where X has k elements (k is assumed to be of type uint256):
:: enc(X) = enc(k) enc([X[1], ..., X[k]])
:: i.e. it is encoded as if it were an array of static size k, prefixed
:: with the number of elements.
%+ weld $(dat [%uint (lent p.dat)])
$(dat [%array-n p.dat])
::
%bytes-n
:: enc(X) is the sequence of bytes in X padded with zero-bytes to a
:: length of 32.
:: Note that for any X, len(enc(X)) is a multiple of 32.
~| [%bytes-n-too-long max=32 actual=p.p.dat]
?> (lte p.p.dat 32)
(pad-to-multiple (render-hex-bytes p.dat) 64 %right)
::
%bytes :: of length k (which is assumed to be of type uint256)
:: enc(X) = enc(k) pad_right(X), i.e. the number of bytes is encoded as a
:: uint256 followed by the actual value of X as a byte sequence, followed
:: by the minimum number of zero-bytes such that len(enc(X)) is a
:: multiple of 32.
%+ weld $(dat [%uint p.p.dat])
(pad-to-multiple (render-hex-bytes p.dat) 64 %right)
::
%string
:: enc(X) = enc(enc_utf8(X)), i.e. X is utf-8 encoded and this value is
:: interpreted as of bytes type and encoded further. Note that the length
:: used in this subsequent encoding is the number of bytes of the utf-8
:: encoded string, not its number of characters.
$(dat [%bytes (lent p.dat) (swp 3 (crip p.dat))])
::
%uint
:: enc(X) is the big-endian encoding of X, padded on the higher-order
:: (left) side with zero-bytes such that the length is a multiple of 32
:: bytes.
(pad-to-multiple (render-hex-bytes (as-octs p.dat)) 64 %left)
::
%bool
:: as in the uint8 case, where 1 is used for true and 0 for false
$(dat [%uint ?:(p.dat 1 0)])
::
%address
:: as in the uint160 case
$(dat [%uint `@ud`p.dat])
==
::
++ is-dynamic-type
|= a=data
?. ?=(%array-n -.a)
?=(?(%string %bytes %array) -.a)
&(!=((lent p.a) 0) (lien p.a is-dynamic-type))
::
:: decoding
::
++ decode-topics decode-arguments
::
++ decode-results
:: rex: string of hex bytes with leading 0x.
|* [rex=@t tys=(list etyp)]
=- (decode-arguments - tys)
%^ rut 9
(rsh [3 2] rex)
(curr rash hex)
::
++ decode-arguments
|* [wos=(list @) tys=(list etyp)]
=/ wos=(list @) wos :: get rid of tmi
=| win=@ud
=< (decode-from 0 tys)
|%
++ decode-from
|* [win=@ud tys=(list etyp)]
?~ tys !!
=- ?~ t.tys dat
[dat $(win nin, tys t.tys)]
(decode-one win ~[i.tys])
::
++ decode-one
::NOTE we take (list etyp) even though we only operate on
:: a single etyp as a workaround for urbit/arvo#673
|* [win=@ud tys=(list etyp)]
=- [nin dat]=- ::NOTE ^= regular form broken
?~ tys !!
=* typ i.tys
=+ wor=(snag win wos)
?+ typ
~| [%unsupported-type typ]
!!
::
?(%address %bool %uint) :: %int %real %ureal
:- +(win)
?- typ
%address `@ux`wor
%uint `@ud`wor
%bool =(1 wor)
==
::
%string
=+ $(tys ~[%bytes])
[nin (trip (swp 3 q.dat))]
::
%bytes
:- +(win)
:: find the word index of the actual data.
=/ lic=@ud (div wor 32)
:: learn the bytelength of the data.
=/ len=@ud (snag lic wos)
(decode-bytes-n +(lic) len)
::
[%bytes-n *]
:- (add win +((div (dec n.typ) 32)))
(decode-bytes-n win n.typ)
::
[%array *]
:- +(win)
:: find the word index of the actual data.
=. win (div wor 32)
:: read the elements from their location.
%- tail
%^ decode-array-n ~[t.typ] +(win)
(snag win wos)
::
[%array-n *]
(decode-array-n ~[t.typ] win n.typ)
==
::
++ decode-bytes-n
|= [fro=@ud bys=@ud]
^- octs
:: parse {bys} bytes from {fro}.
:- bys
%+ rsh
:- 3
=+ (mod bys 32)
?:(=(0 -) - (sub 32 -))
%+ rep 8
%- flop
=- (swag [fro -] wos)
+((div (dec bys) 32))
::
++ decode-array-n
::NOTE we take (list etyp) even though we only operate on
:: a single etyp as a workaround for urbit/arvo#673
::NOTE careful! produces lists without type info
=| res=(list)
|* [tys=(list etyp) fro=@ud len=@ud]
^- [@ud (list)]
?~ tys !!
?: =(len 0) [fro (flop `(list)`res)]
=+ (decode-one fro ~[i.tys]) :: [nin=@ud dat=*]
$(res ^+(res [dat res]), fro nin, len (dec len))
--
--
::
:: communicating with rpc nodes
::NOTE https://github.com/ethereum/wiki/wiki/JSON-RPC
::
++ rpc
:: types
::
=> =, abi
=, format
|%
:: raw call data
++ call-data
$: function=@t
arguments=(list data)
==
::
:: raw transaction data
+$ transaction
$: nonce=@ud
gas-price=@ud
gas=@ud
to=address
value=@ud
data=@ux
chain-id=@ux
==
::
:: ethereum json rpc api
::
:: supported requests.
++ request
$% [%eth-block-number ~]
[%eth-call cal=call deb=block]
$: %eth-new-filter
fro=(unit block)
tob=(unit block)
adr=(list address)
top=(list ?(@ux (list @ux)))
==
[%eth-get-block-by-number bon=@ud txs=?]
[%eth-get-filter-logs fid=@ud]
$: %eth-get-logs
fro=(unit block)
tob=(unit block)
adr=(list address)
top=(list ?(@ux (list @ux)))
==
$: %eth-get-logs-by-hash
has=@
adr=(list address)
top=(list ?(@ux (list @ux)))
==
[%eth-get-filter-changes fid=@ud]
[%eth-get-transaction-count adr=address =block]
[%eth-get-transaction-receipt txh=@ux]
[%eth-send-raw-transaction dat=@ux]
==
::
::TODO clean up & actually use
++ response
$% ::TODO
[%eth-new-filter fid=@ud]
[%eth-get-filter-logs los=(list event-log)]
[%eth-get-logs los=(list event-log)]
[%eth-get-logs-by-hash los=(list event-log)]
[%eth-got-filter-changes los=(list event-log)]
[%eth-transaction-hash haz=@ux]
==
::
++ event-log
$: :: null for pending logs
$= mined %- unit
$: log-index=@ud
transaction-index=@ud
transaction-hash=@ux
block-number=@ud
block-hash=@ux
removed=?
==
::
address=@ux
data=@t
:: event data
::
:: For standard events, the first topic is the event signature
:: hash. For anonymous events, the first topic is the first
:: indexed argument.
:: Note that this does not support the "anonymous event with
:: zero topics" case. This has dubious usability, and using
:: +lest instead of +list saves a lot of ?~ checks.
::
topics=(lest @ux)
==
::
:: data for eth_call.
++ call
$: from=(unit address)
to=address
gas=(unit @ud)
gas-price=(unit @ud)
value=(unit @ud)
data=tape
==
::
:: minimum data needed to construct a read call
++ proto-read-request
$: id=(unit @t)
to=address
call-data
==
::
:: block to operate on.
++ block
$% [%number n=@ud]
[%label l=?(%earliest %latest %pending)]
==
--
::
:: logic
::
|%
++ encode-call
|= call-data
^- tape
::TODO should this check to see if the data matches the function signature?
=- :(weld "0x" - (encode-args arguments))
%+ scag 8
%+ render-hex-bytes 32
%- keccak-256:keccak:crypto
(as-octs:mimes:html function)
::
:: building requests
::
++ json-request
=, eyre
|= [url=purl jon=json]
^- hiss
:^ url %post
%- ~(gas in *math)
~['Content-Type'^['application/json']~]
(some (as-octt (en-json:html jon)))
:: +light-json-request: like json-request, but for %l
::
:: TODO: Exorcising +purl from our system is a much longer term effort;
:: get the current output types for now.
::
++ light-json-request
|= [url=purl:eyre jon=json]
^- request:http
::
:* %'POST'
(crip (en-purl:html url))
~[['content-type' 'application/json']]
(some (as-octt (en-json:html jon)))
==
::
++ batch-read-request
|= req=(list proto-read-request)
^- json
a+(turn req read-request)
::
++ read-request
|= proto-read-request
^- json
%+ request-to-json id
:+ %eth-call
^- call
[~ to ~ ~ ~ `tape`(encode-call function arguments)]
[%label %latest]
::
++ request-to-json
=, enjs:format
|= [riq=(unit @t) req=request]
^- json
%- pairs
=; r=[met=@t pas=(list json)]
::TODO should use request-to-json:rpc:jstd,
:: and probably (fall riq -.req)
:* jsonrpc+s+'2.0'
method+s+met.r
params+a+pas.r
::TODO would just jamming the req noun for id be a bad idea?
?~ riq ~
[id+s+u.riq]~
==
?- -.req
%eth-block-number
['eth_blockNumber' ~]
::
%eth-call
:- 'eth_call'
:~ (eth-call-to-json cal.req)
(block-to-json deb.req)
==
::
%eth-new-filter
:- 'eth_newFilter'
:_ ~
:- %o %- ~(gas by *(map @t json))
=- (murn - same)
^- (list (unit (pair @t json)))
:~ ?~ fro.req ~
`['fromBlock' (block-to-json u.fro.req)]
::
?~ tob.req ~
`['toBlock' (block-to-json u.tob.req)]
::
::TODO fucking tmi
?: =(0 (lent adr.req)) ~
:+ ~ 'address'
?: =(1 (lent adr.req)) (tape (address-to-hex (snag 0 adr.req)))
:- %a
(turn adr.req (cork address-to-hex tape))
::
?~ top.req ~
:+ ~ 'topics'
(topics-to-json top.req)
==
::
%eth-get-block-by-number
:- 'eth_getBlockByNumber'
:~ (tape (num-to-hex bon.req))
b+txs.req
==
::
%eth-get-filter-logs
['eth_getFilterLogs' (tape (num-to-hex fid.req)) ~]
::
%eth-get-logs
:- 'eth_getLogs'
:_ ~
:- %o %- ~(gas by *(map @t json))
=- (murn - same)
^- (list (unit (pair @t json)))
:~ ?~ fro.req ~
`['fromBlock' (block-to-json u.fro.req)]
::
?~ tob.req ~
`['toBlock' (block-to-json u.tob.req)]
::
?: =(0 (lent adr.req)) ~
:+ ~ 'address'
?: =(1 (lent adr.req)) (tape (address-to-hex (snag 0 adr.req)))
:- %a
(turn adr.req (cork address-to-hex tape))
::
?~ top.req ~
:+ ~ 'topics'
(topics-to-json top.req)
==
::
%eth-get-logs-by-hash
:- 'eth_getLogs'
:_ ~ :- %o
%- ~(gas by *(map @t json))
=- (murn - same)
^- (list (unit (pair @t json)))
:~ `['blockHash' (tape (transaction-to-hex has.req))]
::
?: =(0 (lent adr.req)) ~
:+ ~ 'address'
?: =(1 (lent adr.req)) (tape (address-to-hex (snag 0 adr.req)))
:- %a
(turn adr.req (cork address-to-hex tape))
::
?~ top.req ~
:+ ~ 'topics'
(topics-to-json top.req)
==
::
%eth-get-filter-changes
['eth_getFilterChanges' (tape (num-to-hex fid.req)) ~]
::
%eth-get-transaction-count
:- 'eth_getTransactionCount'
:~ (tape (address-to-hex adr.req))
(block-to-json block.req)
==
::
%eth-get-transaction-receipt
['eth_getTransactionReceipt' (tape (transaction-to-hex txh.req)) ~]
::
%eth-send-raw-transaction
['eth_sendRawTransaction' (tape (num-to-hex dat.req)) ~]
==
::
++ eth-call-to-json
=, enjs:format
|= cal=call
^- json
:- %o %- ~(gas by *(map @t json))
=- (murn - same)
^- (list (unit (pair @t json)))
:~ ?~ from.cal ~
`['from' (tape (address-to-hex u.from.cal))]
::
`['to' (tape (address-to-hex to.cal))]
::
?~ gas.cal ~
`['gas' (tape (num-to-hex u.gas.cal))]
::
?~ gas-price.cal ~
`['gasPrice' (tape (num-to-hex u.gas-price.cal))]
::
?~ value.cal ~
`['value' (tape (num-to-hex u.value.cal))]
::
?~ data.cal ~
`['data' (tape data.cal)]
==
::
++ block-to-json
|= dob=block
^- json
?- -.dob
%number s+(crip '0' 'x' ((x-co:co 1) n.dob))
%label s+l.dob
==
::
++ topics-to-json
|= tos=(list ?(@ux (list @ux)))
^- json
:- %a
=/ ttj
;: cork
(cury render-hex-bytes 32)
prefix-hex
tape:enjs:format
==
%+ turn tos
|= t=?(@ (list @))
?@ t
?: =(0 t) ~
(ttj `@`t)
a+(turn t ttj)
::
:: parsing responses
::
::TODO ++ parse-response |= json ^- response
::
++ parse-hex-result
|= j=json
^- @
?> ?=(%s -.j)
(hex-to-num p.j)
::
++ parse-eth-new-filter-res parse-hex-result
::
++ parse-eth-block-number parse-hex-result
::
++ parse-transaction-hash parse-hex-result
::
++ parse-eth-get-transaction-count parse-hex-result
::
++ parse-event-logs
(ar:dejs:format parse-event-log)
::
++ parse-event-log
=, dejs:format
|= log=json
^- event-log
=- ((ot -) log)
:~ =- ['logIndex'^(cu - (mu so))]
|= li=(unit @t)
?~ li ~
=- `((ou -) log) ::TODO not sure if elegant or hacky.
:~ 'logIndex'^(un (cu hex-to-num so))
'transactionIndex'^(un (cu hex-to-num so))
'transactionHash'^(un (cu hex-to-num so))
'blockNumber'^(un (cu hex-to-num so))
'blockHash'^(un (cu hex-to-num so))
'removed'^(uf | bo)
==
::
address+(cu hex-to-num so)
data+so
::
=- topics+(cu - (ar so))
|= r=(list @t)
^- (lest @ux)
?> ?=([@t *] r)
:- (hex-to-num i.r)
(turn t.r hex-to-num)
==
--
::
:: utilities
::TODO give them better homes!
::
++ num-to-hex
|= n=@
^- tape
%- prefix-hex
?: =(0 n)
"0"
%- render-hex-bytes
(as-octs:mimes:html n)
::
++ address-to-hex
|= a=address
^- tape
%- prefix-hex
(render-hex-bytes 20 `@`a)
::
++ transaction-to-hex
|= h=@
^- tape
%- prefix-hex
(render-hex-bytes 32 h)
::
++ prefix-hex
|= a=tape
^- tape
['0' 'x' a]
::
++ render-hex-bytes
:: atom to string of hex bytes without 0x prefix and dots.
|= a=octs
^- tape
((x-co:co (mul 2 p.a)) q.a)
::
++ pad-to-multiple
|= [wat=tape mof=@ud wer=?(%left %right)]
^- tape
=+ len=(lent wat)
?: =(0 len) (reap mof '0')
=+ mad=(mod len mof)
?: =(0 mad) wat
=+ tad=(reap (sub mof mad) '0')
%- weld
?:(?=(%left wer) [tad wat] [wat tad])
::
++ hex-to-num
|= a=@t
(rash (rsh [3 2] a) hex)
--

View File

@ -1,8 +1,9 @@
:: ethio: Asynchronous Ethereum input/output functions.
::.
/+ strandio
::
/- rpc=json-rpc
/+ ethereum, strandio
=, ethereum-types
=, able:jael
=, jael
::
=> |%
+$ topics (list ?(@ux (list @ux)))
@ -37,13 +38,13 @@
++ attempt-request
=/ m (strand:strandio ,(unit results))
^- form:m
;< responses=(list response:rpc:jstd) bind:m
;< responses=(list response:rpc) bind:m
(request-batch-rpc-loose url reqs)
=- ?~ err
(pure:m `res)
(pure:m ~)
%+ roll responses
|= $: rpc=response:rpc:jstd
|= $: rpc=response:rpc
[res=results err=(list [id=@t code=@t message=@t])]
==
?: ?=(%error -.rpc)
@ -63,8 +64,8 @@
`10
attempt-request
::
+$ result response:rpc:jstd
+$ results (list response:rpc:jstd)
+$ result response:rpc
+$ results (list response:rpc)
::
++ attempt-request
=/ m (strand:strandio ,(unit results))
@ -98,7 +99,7 @@
=/ jon=(unit json) (de-json:html body)
?~ jon
(pure:m ~)
=/ array=(unit (list response:rpc:jstd))
=/ array=(unit (list response:rpc))
((ar:dejs-soft:format parse-one-response) u.jon)
?~ array
(strand-fail:strandio %rpc-result-incomplete-batch >u.jon< ~)
@ -106,7 +107,7 @@
::
++ parse-one-response
|= =json
^- (unit response:rpc:jstd)
^- (unit response:rpc)
=/ res=(unit [@t ^json])
%. json
=, dejs-soft:format

View File

@ -198,14 +198,16 @@
++ graph
|= g=^graph
^- json
:- %a
%+ turn (tap:orm g)
%- pairs
%+ turn
(tap:orm g)
|= [a=atom n=^node]
^- json
:- %a
:~ (index [a]~)
(node n)
==
^- [@t json]
:_ (node n)
=/ idx (numb a)
?> ?=(%n -.idx)
p.idx
::
++ node
|= n=^node
^- json
@ -222,14 +224,14 @@
++ nodes
|= m=(map ^index ^node)
^- json
:- %a
%- pairs
%+ turn ~(tap by m)
|= [n=^index o=^node]
^- json
:- %a
:~ (index n)
(node o)
==
^- [@t json]
:_ (node o)
=/ idx (index n)
?> ?=(%s -.idx)
p.idx
::
++ indices
|= i=(set ^index)
@ -310,11 +312,11 @@
==
::
++ internal-graph
^- $-(json ^internal-graph)
%- of
:~ [%empty ul]
[%graph graph]
==
|= jon=json
^- ^internal-graph
?~ jon
[%empty ~]
[%graph (graph jon)]
::
++ post
%- ot
@ -335,17 +337,29 @@
[%code eval]
==
::
++ tang
|= jon=^json
^- ^tang
?> ?=(%a -.jon)
%- zing
%+ turn
p.jon
|= jo=^json
^- (list tank)
?> ?=(%a -.jo)
%+ turn
p.jo
|= j=^json
?> ?=(%s -.j)
^- tank
leaf+(trip p.j)
::
++ eval
|= a=^json
^- [cord (list tank)]
=, ^? dejs-soft:format
=+ exp=((ot expression+so ~) a)
%- need
?~ exp [~ '' ~]
:+ ~ u.exp
:: NOTE: when sending, if output is an empty list,
:: graph-store will evaluate
(fall ((ot output+(ar dank) ~) a) ~)
%- ot
:~ expression+so
output+tang
==
::
++ remove-nodes
%- ot

View File

@ -16,6 +16,7 @@
join+join
leave+leave
groupify+groupify
eval+so
::invite+invite
==
::

View File

@ -17,6 +17,26 @@
%+ scry-for update:store
/graph/(scot %p entity.res)/[name.res]
::
++ get-graph-mop
|= res=resource
^- graph:store
=/ =update:store
(get-graph res)
?> ?=(%0 -.update)
?> ?=(%add-graph -.q.update)
graph.q.update
::
++ gut-younger-node-siblings
|= [res=resource =index:store]
^- (map index:store node:store)
=+ %+ scry-for ,=update:store
%+ weld
/node-siblings/younger/(scot %p entity.res)/[name.res]/all
(turn index (cury scot %ud))
?> ?=(%0 -.update)
?> ?=(%add-nodes -.q.update)
nodes.q.update
::
++ got-node
|= [res=resource =index:store]
^- node:store
@ -53,4 +73,27 @@
?> ?=(%0 -.update)
?> ?=(%keys -.q.update)
resources.q.update
::
++ tap-deep
|= =graph:store
^- (list [index:store node:store])
=| =index:store
=/ nodes=(list [atom node:store])
(tap:orm:store graph)
|- =* tap-nodes $
^- (list [index:store node:store])
%- zing
%+ turn
nodes
|= [=atom =node:store]
^- (list [index:store node:store])
%+ welp
^- (list [index:store node:store])
[(snoc index atom) node]~
?. ?=(%graph -.children.node)
~
%_ tap-nodes
index (snoc index atom)
nodes (tap:orm:store p.children.node)
==
--

View File

@ -1,5 +1,5 @@
/- sur=hark-store, post
/+ resource, graph-store, group-store, chat-store
/+ resource, graph-store, group-store
^?
=< [. sur]
=, sur
@ -11,13 +11,6 @@
%- of
:~ graph+graph-index
group+group-index
chat+chat-index
==
::
++ chat-index
%- ot
:~ chat+pa
mention+bo
==
::
++ group-index
@ -32,6 +25,18 @@
graph+dejs-path:resource
module+so
description+so
index+(su ;~(pfix fas (more fas dem)))
==
::
++ stats-index
%- of
:~ graph+graph-stats-index
group+dejs-path:resource
==
++ graph-stats-index
%- ot
:~ graph+dejs-path:resource
index+graph-store-index
==
:: parse date as @ud
:: TODO: move to zuse
@ -40,7 +45,6 @@
^- @da
?> ?=(%s -.jon)
`@da`(rash p.jon dem:ag)
::
++ notif-ref
^- $-(json [@da ^index])
@ -48,21 +52,30 @@
:~ time+sd
index+index
==
++ graph-store-index
(su ;~(pfix fas (more fas dem)))
::
++ add
|= jon=json
[*^index *notification]
::
++ read-graph-index
%- ot
:~ index+stats-index
target+graph-store-index
==
::
++ action
^- $-(json ^action)
%- of
:~ seen+ul
archive+notif-ref
unread+notif-ref
read+notif-ref
add+add
unread-note+notif-ref
read-note+notif-ref
add-note+add
set-dnd+bo
read-index+index
read-count+stats-index
read-each+read-graph-index
==
--
::
@ -79,25 +92,67 @@
%timebox (timebox +.upd)
%set-dnd b+dnd.upd
%count (numb count.upd)
%unreads (unreads unreads.upd)
%more (more +.upd)
%read-each (read-each +.upd)
%read-count (stats-index +.upd)
%unread-each (unread-each +.upd)
%unread-count (unread-count +.upd)
%remove-graph s+(enjs-path:resource +.upd)
%seen-index (seen-index +.upd)
%unreads (unreads +.upd)
::
?(%archive %read %unread)
?(%archive %read-note %unread-note)
(notif-ref +.upd)
==
::
++ stats-index
|= s=^stats-index
%+ frond -.s
|^
?- -.s
%graph (graph-stats-index +.s)
%group s+(enjs-path:resource +.s)
==
::
++ graph-stats-index
|= [graph=resource =index:graph-store]
%- pairs
:~ graph+s+(enjs-path:resource graph)
index+(index:enjs:graph-store index)
==
--
::
++ unreads
|= l=(list [^index @ud])
|= l=(list [^stats-index ^stats])
^- json
:- %a
^- (list json)
%+ turn l
|= [idx=^index unread=@ud]
|= [idx=^stats-index s=^stats]
%- pairs
:~ unread+(numb unread)
index+(index idx)
:~ stats+(stats s)
index+(stats-index idx)
==
::
++ unread
|= =^unreads
%+ frond
-.unreads
?- -.unreads
%each a+(turn ~(tap by indices.unreads) index:enjs:graph-store)
::
%count
(numb num.unreads)
==
::
++ stats
|= s=^stats
^- json
%- pairs
:~ unreads+(unread unreads.s)
notifications+(numb notifications.s)
last+(time last-seen.s)
==
++ added
|= [tim=@da idx=^index not=^notification]
^- json
@ -114,6 +169,13 @@
:~ time+s+(scot %ud tim)
index+(index idx)
==
++ seen-index
|= [tim=@da idx=^stats-index]
^- json
%- pairs
:~ time+(time tim)
index+(stats-index idx)
==
::
++ more
|= upds=(list ^update)
@ -127,25 +189,22 @@
?- -.index
%graph (graph-index +.index)
%group (group-index +.index)
%chat (chat-index +.index)
==
::
++ chat-index
|= [chat=^path mention=?]
^- json
%- pairs
:~ chat+(path chat)
mention+b+mention
==
::
++ graph-index
|= [group=resource graph=resource module=@t description=@t]
|= $: group=resource
graph=resource
module=@t
description=@t
idx=index:graph-store
==
^- json
%- pairs
:~ group+s+(enjs-path:resource group)
graph+s+(enjs-path:resource graph)
module+s+module
description+s+description
index+(index:enjs:graph-store idx)
==
::
++ group-index
@ -174,15 +233,8 @@
?- -.contents
%graph (graph-contents +.contents)
%group (group-contents +.contents)
%chat (chat-contents +.contents)
==
::
++ chat-contents
|= =(list envelope:chat-store)
^- json
:- %a
(turn list envelope:enjs:chat-store)
::
++ graph-contents
|= =(list post:post)
^- json
@ -221,6 +273,47 @@
^- json
(indexed-notification index notification)
==
::
++ read-each
|= [s=^stats-index target=index:graph-store]
%- pairs
:~ index+(stats-index s)
target+(index:enjs:graph-store target)
==
::
++ unread-each
|= [s=^stats-index target=index:graph-store tim=@da]
%- pairs
:~ index+(stats-index s)
target+(index:enjs:graph-store target)
last+(time tim)
==
::
++ unread-count
|= [s=^stats-index tim=@da]
%- pairs
:~ index+(stats-index s)
last+(time tim)
==
--
--
::
++ to-stats-index
|= =index
^- stats-index
?- -.index
%graph [%graph graph.index index.index]
%group [%group group.index]
==
++ stats-index-is-index
|= [=stats-index =index]
?- -.index
%graph
?. ?=(%graph -.stats-index) %.n
=([graph index]:index [graph index]:stats-index)
::
%group
?. ?=(%group -.stats-index) %.n
=(group:index group:stats-index)
==
--

View File

@ -564,7 +564,12 @@
::
++ se-klin :: disconnect app
|= gyl=gill:gall
+>(eel (~(del in eel) gyl))
=/ gil=(unit gill:gall) se-agon
=. eel (~(del in eel) gyl)
?~ gil +>.$
?: =(gyl u.gil)
+>.$(inx 0)
(se-alas u.gil)
::
++ se-link :: connect to app
|= gyl=gill:gall
@ -788,6 +793,7 @@
?- fec
[%bel *] ta-bel
[%blk *] +>
[%bye *] +>(..ta (se-klin gyl))
[%clr *] +>(..ta (se-blit fec))
[%det *] (ta-got +.fec)
[%err *] (ta-err p.fec)

View File

@ -43,10 +43,10 @@
::
++ poke-rekey :: rotate private keys
|= des=@t
=/ sed=(unit seed:able:jael)
=/ sed=(unit seed:jael)
%+ biff
(bind (slaw %uw des) cue)
(soft seed:able:jael)
(soft seed:jael)
=< abet
?~ sed
~& %invalid-private-key
@ -67,13 +67,13 @@
=. p.hot (scag 2 p.hot) :: ignore subdomain
=. dat (scot %uw (en:crub:crypto ames-secret dat))
=- abet:(emit %pass /write %arvo %c %info -)
=/ byk=path (en-beam:format byk.bowl(r da+now.bowl) ~)
=/ byk=path (en-beam byk.bowl(r da+now.bowl) ~)
=+ .^(=tube:clay cc+(welp byk /mime/atom))
=/ =cage atom+(tube !>([/ (as-octs:mimes:html dat)]))
(foal:space:userlib :(welp byk sec+p.hot /atom) cage)
::
++ poke-moon :: rotate moon keys
|= sed=(unit [=ship =udiff:point:able:jael])
|= sed=(unit [=ship =udiff:point:jael])
=< abet
?~ sed
this

View File

@ -109,10 +109,12 @@
++ on-peek
|= =path
^- (unit (unit cage))
?+ path [~ ~]
[%x %kiln %ota ~] ``noun+!>(ota)
[%x %kiln %our ~] ``noun+!>(our)
[%x %kiln %base-hash ~] ``noun+!>((base-hash:version our now))
?+ path [~ ~]
[%x %kiln %ota ~] ``noun+!>(ota)
[%x %kiln %our ~] ``noun+!>(our)
[%x %kiln %base-hash ~]
=/ ver (base-hash:version our now)
``noun+!>(?~(ver 0v0 i.ver))
==
::
++ poke-commit

View File

@ -1,14 +1,14 @@
/+ base64, primitive-rsa, *pkcs
/+ primitive-rsa, *pkcs
=* rsa primitive-rsa
|%
:: +en-base64url: url-safe base64 encoding, without padding
::
++ en-base64url
~(en base64 | &)
~(en base64:mimes:html | &)
:: +de-base64url: url-safe base64 decoding, without padding
::
++ de-base64url
~(de base64 | &)
~(de base64:mimes:html | &)
:: |octn: encode/decode unsigned atoms as big-endian octet stream
::
++ octn

View File

@ -0,0 +1,31 @@
:: json-rpc: protocol utilities
::
/- *json-rpc
|%
++ request-to-hiss
|= [url=purl:eyre req=request]
^- hiss:eyre
:- url
:+ %post
%- ~(gas in *math:eyre)
~['Content-Type'^['application/json']~]
%- some
%- as-octt:mimes:html
(en-json:html (request-to-json req))
::
++ request-to-json
|= request
^- json
%- pairs:enjs:format
:~ jsonrpc+s+'0.2'
id+s+id
method+s+method
::
:- %params
^- json
?- -.params
%list [%a +.params]
%object [%o (~(gas by *(map @t json)) +.params)]
==
==
--

View File

@ -2,7 +2,7 @@
::
/- keygen
::
/+ bip32, bip39
/+ ethereum, bip32, bip39
::
=, keygen
::

View File

@ -1,4 +1,4 @@
|%
^? |%
++ remake-set
|* s=(tree)
(sy ~(tap in s))

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