ilyakooo0/urbit
1
0
Fork 0
mirror of https://github.com/ilyakooo0/urbit.git synced 2024-11-24 10:33:22 +03:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
fang 2021-06-23 11:19:48 +02:00
commit 2640a3352a
No known key found for this signature in database
GPG Key ID: EB035760C1BBA972
324 changed files with 44274 additions and 3741 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -1,3 +1,4 @@
bin/* filter=lfs diff=lfs merge=lfs -text
bin/*/* filter=lfs diff=lfs merge=lfs -text
pkg/arvo/**/*.css binary
**/package-lock.json binary merge=theirs

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

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

8
.github/actions/glob/entrypoint.sh vendored
View File

@ -10,10 +10,10 @@ chmod 600 service-account
chmod 600 id_ssh
chmod 600 id_ssh.pub
janeway release glob --dev --no-pill \
janeway release glob-all --dev --no-pill \
--credentials service-account \
--ssh-key id_ssh \
--do-it-live \
--ci \
| bash
SHORTHASH=$(git rev-parse --short HEAD)
@ -21,12 +21,12 @@ SHORTHASH=$(git rev-parse --short HEAD)
janeway release prepare-ota arvo-glob-"$SHORTHASH" "$1" \
--credentials service-account \
--ssh-key id_ssh \
--do-it-live \
--ci \
| bash
janeway release perform-ota "$1" \
--credentials service-account \
--ssh-key id_ssh \
--do-it-live \
--ci \
| bash

27
.github/workflows/chromatic.yml vendored Normal file
View File

@ -0,0 +1,27 @@
name: Chromatic Deployment
on:
pull_request:
paths:
- 'pkg/interface/**'
push:
paths:
- 'pkg/interface/**'
branches:
- 'release/next-userspace'
jobs:
chromatic-deployment:
runs-on: ubuntu-latest
name: "Deploy Chromatic"
steps:
- uses: actions/checkout@v2
with:
fetch-depth: 0
- run: cd 'pkg/interface' && npm i
- name: Publish to Chromatic
uses: chromaui/action@v1
with:
token: ${{ secrets.GITHUB_TOKEN }}
projectToken: ${{ secrets.CHROMATIC_PROJECT_TOKEN }}
workingDir: pkg/interface

4
.github/workflows/glob.yml vendored
View File

@ -6,14 +6,14 @@ on:
jobs:
glob:
runs-on: ubuntu-latest
name: "Create and deploy a glob to ~lomlyx-lopsem-nidsut-tomdun"
name: "Create and deploy a glob to ~hanruc-nalfus-nidsut-tomdun"
steps:
- uses: actions/checkout@v2
with:
lfs: true
- uses: ./.github/actions/glob
with:
ship: 'lomlyx-lopsem-nidsut-tomdun'
ship: 'hanruc-nalfus-nidsut-tomdun'
credentials: ${{ secrets.JANEWAY_SERVICE_KEY }}
ssh-sec-key: ${{ secrets.JANEWAY_SSH_SEC_KEY }}
ssh-pub-key: ${{ secrets.JANEWAY_SSH_PUB_KEY }}

14
.github/workflows/typescript-check.yml vendored Normal file
View File

@ -0,0 +1,14 @@
name: typescript-check
on:
pull_request:
paths:
- 'pkg/interface/**'
jobs:
typescript-check:
runs-on: ubuntu-latest
name: "Check pkg/interface types"
steps:
- uses: actions/checkout@v2
- run: cd 'pkg/interface' && npm i && npm run tsc

2
.gitignore vendored
View File

@ -76,4 +76,4 @@ pkg/interface/link-webext/web-ext-artifacts
*.xz
# Logs
*.log
*.log

4
bin/brass.pill
View File

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

4
bin/solid.pill
View File

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

362
pkg/arvo/app/btc-provider.hoon Normal file
View File

@ -0,0 +1,362 @@
:: btc-provider.hoon
:: Proxy that serves a BTC full node and ElectRS address indexer
::
:: Subscriptions: none
:: To Subscribers: /clients
:: current connection state
:: results/errors of RPC calls
::
:: Scrys
:: x/is-whitelisted/SHIP: bool, whether ship is whitelisted
::
/- *bitcoin, json-rpc, *btc-provider
/+ dbug, default-agent, bl=btc, groupl=group, resource
|%
+$ versioned-state
$% state-0
==
::
+$ state-0 [%0 =host-info =whitelist]
::
+$ card card:agent:gall
::
--
%- agent:dbug
=| state-0
=* state -
^- agent:gall
=<
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
hc ~(. +> bowl)
::
++ on-init
^- (quip card _this)
~& > '%btc-provider initialized successfully'
=| wl=^whitelist
:- ~
%_ this
host-info
['' connected=%.n %main block=0 clients=*(set ship)]
whitelist wl(public %.n, kids %.n)
==
::
++ on-save
^- vase
!>(state)
::
++ on-load
|= old-state=vase
^- (quip card _this)
~& > '%btc-provider recompiled successfully '
`this(state !<(versioned-state old-state))
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
?> ?|((team:title our.bowl src.bowl) (is-client:hc src.bowl))
=^ cards state
?+ mark (on-poke:def mark vase)
%btc-provider-command
?> (team:title our.bowl src.bowl)
(handle-command:hc !<(command vase))
%btc-provider-action
(handle-action:hc !<(action vase))
==
[cards this]
::
++ on-watch
|= pax=path
^- (quip card _this)
:: checking provider permissions before trying to subscribe
:: terrible hack until we have cross-ship scries
::
?: ?=([%permitted @ ~] pax)
:_ this
=/ jon=json
%+ frond:enjs:format
%'providerStatus'
%- pairs:enjs:format
:~ provider+s+(scot %p our.bowl)
permitted+b+(is-whitelisted:hc src.bowl)
==
[%give %fact ~ %json !>(jon)]~
::
?> ?=([%clients *] pax)
?. (is-whitelisted:hc src.bowl)
~|("btc-provider: blocked client {<src.bowl>}" !!)
~& > "btc-provider: accepted client {<src.bowl>}"
:- [do-ping:hc]~
this(clients.host-info (~(put in clients.host-info) src.bowl))
::
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card _this)
:: check for connectivity every 30 seconds
::
?: ?=([%ping-timer *] wire)
:_ this
:~ do-ping:hc
(start-ping-timer:hc ~s30)
==
=^ cards state
?+ +<.sign-arvo (on-arvo:def wire sign-arvo)
%http-response
(handle-rpc-response:hc wire client-response.sign-arvo)
==
[cards this]
::
++ on-peek
|= pax=path
^- (unit (unit cage))
?+ pax (on-peek:def pax)
[%x %is-whitelisted @t ~]
``noun+!>((is-whitelisted:hc (ship (slav %p +>-.pax))))
::
[%x %is-client @t ~]
``noun+!>((is-client (ship (slav %p +>-.pax))))
==
::
++ on-leave on-leave:def
++ on-agent on-agent:def
++ on-fail on-fail:def
--
:: helper core
|_ =bowl:gall
++ handle-command
|= comm=command
^- (quip card _state)
?- -.comm
%set-credentials
:- :~ do-ping
(start-ping-timer ~s30)
==
%= state
host-info
[api-url.comm connected=%.n network.comm block=0 clients=*(set ship)]
==
::
%add-whitelist
?- -.wt.comm
%public
`state(public.whitelist %.y)
::
%kids
`state(kids.whitelist %.y)
::
%users
`state(users.whitelist (~(uni in users.whitelist) users.wt.comm))
::
%groups
`state(groups.whitelist (~(uni in groups.whitelist) groups.wt.comm))
==
::
%remove-whitelist
=. state
?- -.wt.comm
%public
state(public.whitelist %.n)
::
%kids
state(kids.whitelist %.n)
::
%users
state(users.whitelist (~(dif in users.whitelist) users.wt.comm))
::
%groups
state(groups.whitelist (~(dif in groups.whitelist) groups.wt.comm))
==
clean-client-list
==
:: if not connected, only %ping action is allowed
::
++ handle-action
|= act=action
^- (quip card _state)
?. ?|(connected.host-info ?=(%ping -.act))
~& >>> "Not connected to RPC"
[~[(send-update [%| %not-connected 500])] state]
::
=/ ract=action:rpc-types
?- -.act :: ~|("Invalid action" !!)
%address-info
[%get-address-info address.act]
::
%tx-info
[%get-tx-vals txid.act]
::
%raw-tx
[%get-raw-tx txid.act]
::
%broadcast-tx
[%broadcast-tx rawtx.act]
::
%ping
[%get-block-info ~]
::
%block-info
[%get-block-info block.act]
==
[~[(req-card act ract)] state]
::
++ req-card
|= [act=action ract=action:rpc-types]
=| out=outbound-config:iris
=/ req=request:http
(gen-request:bl host-info ract)
[%pass (rpc-wire act) %arvo %i %request req out]
:: wire structure: /action-tas/now
::
++ rpc-wire
|= act=action ^- wire
/[-.act]/[(scot %ux (cut 3 [0 20] eny.bowl))]
::
++ kick-client
|= client=ship
^- (quip card _state)
~& >>> "dropping client {<client>}"
:- ~[[%give %kick ~[/clients] `client]]
state(clients.host-info (~(dif in clients.host-info) (silt ~[client])))
::
:: Handles HTTP responses from RPC servers. Parses for errors, then handles response.
:: For actions that require collating multiple RPC calls, uses req-card to call out
:: to RPC again if more information is required.
::
++ handle-rpc-response
|= [=wire response=client-response:iris]
^- (quip card _state)
?. ?=(%finished -.response) `state
=* status status-code.response-header.response
:: handle error types: connection errors, RPC errors (in order)
::
=^ conn-err state
(connection-error status)
?^ conn-err
:_ state(connected.host-info %.n)
~[(send-status [%disconnected ~]) (send-update [%| u.conn-err])]
::
%+ handle-rpc-result wire
%- parse-result:rpc:bl
(get-rpc-response:bl response)
::
++ connection-error
|= status=@ud
^- [(unit error) _state]
?+ status [`[%rpc-error ~] state]
%200
[~ state]
%400
[`[%bad-request status] state]
%401
[`[%no-auth status] state(connected.host-info %.n)]
%502
[`[%not-connected status] state(connected.host-info %.n)]
%504
[`[%not-connected status] state(connected.host-info %.n)]
==
::
++ handle-rpc-result
|= [=wire r=result:rpc-types]
^- (quip card _state)
?+ -.wire ~|("Unexpected HTTP response" !!)
%address-info
?> ?=([%get-address-info *] r)
:_ state
~[(send-update [%.y %address-info +.r])]
::
%tx-info
?> ?=([%get-tx-vals *] r)
:_ state
~[(send-update [%.y %tx-info +.r])]
::
%raw-tx
?> ?=([%get-raw-tx *] r)
:_ state
~[(send-update [%.y %raw-tx +.r])]
::
%broadcast-tx
?> ?=([%broadcast-tx *] r)
:_ state
~[(send-update [%.y %broadcast-tx +.r])]
::
%ping
?> ?=([%get-block-info *] r)
:_ state(connected.host-info %.y, block.host-info block.r)
?: =(block.host-info block.r)
~[(send-status [%connected network.host-info block.r fee.r])]
~[(send-status [%new-block network.host-info block.r fee.r blockhash.r blockfilter.r])]
::
%block-info
?> ?=([%get-block-info *] r)
:_ state
~[(send-update [%.y %block-info network.host-info +.r])]
==
::
++ send-status
|= =status ^- card
%- ?: ?=(%new-block -.status)
~&(>> "%new-block: {<block.status>}" same)
same
[%give %fact ~[/clients] %btc-provider-status !>(status)]
::
++ send-update
|= =update
^- card
=+ c=[%give %fact ~[/clients] %btc-provider-update !>(update)]
?: ?=(%.y -.update)
:: ~& >> "prov. update: {<p.update>}"
c
~& >> "prov. err: {<p.update>}"
c
::
++ is-whitelisted
|= user=ship ^- ?
|^
?| public.whitelist
=(our.bowl user)
?&(kids.whitelist is-kid)
(~(has in users.whitelist) user)
in-group
==
++ is-kid
=(our.bowl (sein:title our.bowl now.bowl user))
++ in-group
=/ gs ~(tap in groups.whitelist)
|-
?~ gs %.n
?: (~(is-member groupl bowl) user i.gs)
%.y
$(gs t.gs)
:: .^((unit group:g) %gx ;:(weld /=group-store=/groups p /noun))
--
:: +clean-client-list: remove clients who are no longer whitelisted
:: called after a whitelist change
::
++ clean-client-list
^- (quip card _state)
=/ to-kick=(set ship)
%- silt
%+ murn ~(tap in clients.host-info)
|= c=ship ^- (unit ship)
?:((is-whitelisted c) ~ `c)
:_ state(clients.host-info (~(dif in clients.host-info) to-kick))
%+ turn ~(tap in to-kick)
|=(c=ship [%give %kick ~[/clients] `c])
::
++ is-client
|= user=ship ^- ?
(~(has in clients.host-info) user)
::
++ start-ping-timer
|= interval=@dr ^- card
[%pass /ping-timer %arvo %b %wait (add now.bowl interval)]
::
++ do-ping
^- card
=/ act=action [%ping ~]
:* %pass /ping/[(scot %da now.bowl)] %agent
[our.bowl %btc-provider] %poke
%btc-provider-action !>(act)
==
--

1213
pkg/arvo/app/btc-wallet.hoon Normal file
View File

File diff suppressed because it is too large Load Diff

4
pkg/arvo/app/btc-wallet/img/tile.svg Normal file
View File

@ -0,0 +1,4 @@
<svg width="128" height="128" viewBox="0 0 128 128" preserveAspectRatio="none" fill="none" xmlns="http://www.w3.org/2000/svg">
<rect width="128" height="128" rx="4" fill="#F98E40"/>
<path d="M75.9373 60.7714C76.4367 57.4333 73.8951 55.6389 70.4198 54.4418L71.5471 49.9199L68.7947 49.2339L67.6971 53.6366C66.9735 53.4563 66.2303 53.2862 65.4919 53.1177L66.5972 48.686L63.8463 48L62.7182 52.5203C62.1193 52.3839 61.5313 52.249 60.9606 52.1071L60.9637 52.093L57.1678 51.1452L56.4356 54.0851C56.4356 54.0851 58.4778 54.5531 58.4347 54.5821C59.5495 54.8604 59.751 55.5981 59.7172 56.1829L58.4331 61.3343C58.51 61.3539 58.6095 61.3821 58.7193 61.426C58.6276 61.4033 58.5296 61.3782 58.4284 61.3539L56.6285 68.5702C56.4921 68.9089 56.1463 69.4169 55.3671 69.224C55.3945 69.264 53.3664 68.7246 53.3664 68.7246L52 71.8754L55.5819 72.7683C56.2483 72.9352 56.9013 73.1101 57.5441 73.2747L56.4051 77.8483L59.1544 78.5343L60.2825 74.0093C61.0335 74.2131 61.7626 74.4013 62.476 74.5784L61.3518 79.0822L64.1043 79.7682L65.2434 75.2032C69.9369 76.0915 73.4663 75.7332 74.9519 71.4881C76.149 68.07 74.8923 66.0984 72.4228 64.8127C74.2212 64.398 75.5759 63.215 75.9373 60.7714V60.7714ZM69.6484 69.5901C68.7978 73.0082 63.0428 71.1604 61.177 70.6971L62.6884 64.6379C64.5543 65.1035 70.5374 66.0255 69.6484 69.5901ZM70.4998 60.722C69.7236 63.8312 64.9337 62.2515 63.3799 61.8642L64.7502 56.3687C66.304 56.756 71.308 57.4788 70.4998 60.722Z" fill="white" fill-opacity="0.7"/>
</svg>
Side by Side

After

Width:  |  Height:  |  Size: 1.4 KiB

31
pkg/arvo/app/btc-wallet/index.html Normal file
View File

@ -0,0 +1,31 @@
<!doctype html>
<html>
<head>
<title>Wallet</title>
<meta charset="utf-8" />
<meta name="viewport"
content="width=device-width, initial-scale=1, shrink-to-fit=no,maximum-scale=1"/>
<meta name="apple-mobile-web-app-capable" content="yes" />
<meta name="apple-touch-fullscreen" content="yes" />
<meta name="apple-mobile-web-app-status-bar-style" content="default" />
<!--
<link rel="apple-touch-icon" href="/~btc/img/touch_icon.png">
<link rel="icon" type="image/png" href="/~btc/img/Favicon.png">
-->
<link rel="manifest"
href='data:application/manifest+json,{
"name": "Wallet",
"short_name": "Wallet",
"description": "A%20bitcoin%20wallet%20for%20urbit",
"display": "standalone",
"background_color": "%23FFFFFF",
"theme_color": "%23000000"}' />
</head>
<body>
<div id="root"></div>
<div id="portal-root"></div>
<script src="/~landscape/js/channel.js"></script>
<script src="/~landscape/js/session.js"></script>
<script src="/~btc/js/bundle/index.f7ab13b7db3ec1f8b55a.js"></script>
</body>
</html>

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

@ -918,7 +918,7 @@
^- (quip card _state)
:_ state
=- (turn - print:sh-out)
:~ ";view ~host/chat to print messages for a chat you've already jonied."
:~ ";view ~host/chat to print messages for a chat you've already joined."
";flee ~host/chat to stop printing messages for a chat."
"For more details:"
"https://urbit.org/using/operations/using-your-ship/#messaging"

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

@ -233,7 +233,7 @@
|= =path
^- (unit (unit cage))
?+ path (on-peek:def path)
[%x %all ~] ``noun+!>(rolodex)
[%x %all ~] ``noun+!>(`rolodex:store`rolodex)
::
[%x %contact @ ~]
=/ =ship (slav %p i.t.t.path)
@ -245,14 +245,13 @@
::
[%x %allowed-ship @ ~]
=/ =ship (slav %p i.t.t.path)
``noun+!>((~(has in allowed-ships) ship))
``noun+!>(`?`(~(has in allowed-ships) ship))
::
[%x %is-public ~]
``noun+!>(is-public)
``noun+!>(`?`is-public)
::
[%x %allowed-groups ~]
``noun+!>(allowed-groups)
``noun+!>(`(set resource)`allowed-groups)
::
[%x %is-allowed @ @ @ @ ~]
=/ is-personal =(i.t.t.t.t.t.path 'true')

323
pkg/arvo/app/dm-hook.hoon Normal file
View File

@ -0,0 +1,323 @@
:: dm-hook [landscape]: receive and send DMs
::
/+ default-agent, dbug, store=graph-store, graphlib=graph, agentio, resource
/+ sig=signatures, hook=dm-hook
::
|%
::
+$ base-state-0
$: screening=?
screened=(jug ship [=index:store =node:store])
pending=(jar ship atom)
==
::
+$ state-0 [%0 base-state-0]
+$ state-1 [%1 base-state-0]
+$ versioned-state
$% state-0
state-1
==
+$ card card:agent:gall
+$ nodes (map index:store node:store)
++ orm orm:store
--
::
=| state-1
=* state -
%- agent:dbug
^- agent:gall
::
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
gra ~(. graphlib bowl)
io ~(. agentio bowl)
pass pass:io
::
++ on-init
:_ this
:_ ~
=/ dms=(list resource)
?. .^(? %gu (scry:io %graph-store ~))
~
%+ skim ~(tap in get-keys:gra)
|=([ship name=term] ?=(^ (rush name ;~(pfix (jest 'dm--') fed:ag))))
|^
%+ poke-our:pass %graph-store
%+ update:cg:gra now.bowl
:+ %add-graph [our.bowl %dm-inbox]
[graph `%graph-validator-dm %.n]
::
++ dm-parser
;~(pfix (jest 'dm--') fed:ag)
::
++ counterparty
|= rid=resource
=/ =ship (rash name.rid dm-parser)
?. =(our.bowl ship) ship
entity.rid
::
++ update-indices
|= [pfix=index:store =graph:store]
=* loop $
^- graph:store
%+ gas:orm *graph:store
%+ turn (tap:orm graph)
|= [=atom =node:store]
^- [^atom node:store]
=/ =index:store (snoc pfix atom)
:- atom
=. children.node
?: ?=(%empty -.children.node) children.node
[%graph loop(pfix index, graph p.children.node)]
?: ?=(%| -.post.node) node
node(index.p.post index)
::
++ graph
%+ roll dms
|= [rid=resource =graph:store]
^- graph:store
=/ =ship (counterparty rid)
=| =post:store
=: author.post our.bowl
index.post [ship ~]
time-sent.post now.bowl
==
=/ dm=graph:store
(update-indices ~[ship] (get-graph-mop:gra rid))
(put:orm:store graph `@`ship [%& post] %graph dm)
--
::
++ on-save !>(state)
++ on-load
|= =vase
^- (quip card _this)
=+ !<(old=versioned-state vase)
?: ?=(%1 -.old) `this(state old)
:_ this(state [%1 +.old])
(poke-self:pass noun+!>(%reinit))^~
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
|^
?+ mark (on-poke:def mark vase)
%noun
?+ q.vase !!
%reinit
?: (~(has in get-keys:gra) [our.bowl %dm-inbox])
`this
on-init
==
::
%dm-hook-action
=+ !<(=action:hook vase)
=^ cards state
?+ -.action !!
%accept (accept-screen ship.action)
%decline (decline-screen ship.action)
%screen (set-screen screen.action)
==
[cards this]
::
%graph-update-2
=+ !<(=update:store vase)
?+ -.q.update !!
%add-nodes
?> ?=([@ %dm-inbox] resource.q.update)
=^ cards state
?: =(our.bowl src.bowl)
(outgoing-add (hash-and-sign nodes.q.update))
?: &(screening !(dm-exists src.bowl))
(screen-add nodes.q.update)
(incoming-add nodes.q.update)
[cards this]
==
==
::
++ hash-and-sign
|= =nodes
%- ~(gas by *^nodes)
%+ turn ~(tap by nodes)
|= [=index:store =node:store]
^- [index:store node:store]
:- index
?> ?=(%& -.post.node)
=* p post.node
=/ =hash:store
`@ux`(sham [~ author time-sent contents]:p.p)
%_ node
hash.p.post `hash
::
signatures.p.post
%- ~(gas in *signatures:store)
[(sign:sig our.bowl now.bowl hash)]~
==
::
++ give
|= =action:hook
^- card
(fact:io dm-hook-action+!>(action) ~[/updates])
::
++ accept-screen
|= =ship
^- (quip card _state)
=/ unscreened=nodes
%- ~(gas by *nodes)
~(tap in (~(get ju screened) ship))
:_ state(screened (~(del by screened) ship))
%+ welp (add-missing-root ship)
:~ %+ poke-our:pass %graph-store
(update:cg:gra now.bowl %add-nodes [our.bowl %dm-inbox] unscreened)
::
(give %accept ship)
==
::
++ set-screen
|= screen=?
:_ state(screening screen)
(give %screen screen)^~
::
++ decline-screen
|= =ship
^- (quip card _state)
:_ state(screened (~(del by screened) ship))
(give %decline ship)^~
::
++ screen-add
|= =nodes
?> =(1 ~(wyt by nodes))
=/ ship-screen (~(get ju screened) src.bowl)
=. ship-screen (~(uni in ship-screen) (normalize-incoming nodes))
=. screened (~(put by screened) src.bowl ship-screen)
:_ state
=/ =action:hook
[%pendings ~(key by screened)]
(fact:io dm-hook-action+!>(action) ~[/updates])^~
::
++ dm-exists
|= =ship
=/ =index:store
[ship ~]
(check-node-existence:gra [our.bowl %dm-inbox] index)
::
++ add-node
|= [=index:store =node:store]
^- update:store
:^ now.bowl %add-nodes [our.bowl %dm-inbox]
(~(gas by *nodes) [index node] ~)
::
++ add-missing-root
|= =ship
^- (list card)
?: (dm-exists ship) ~
=/ =index:store
[ship ~]
=| =post:store
=: author.post our.bowl
index.post index
time-sent.post now.bowl
==
=/ =node:store
[%&^post %empty ~]
(poke-our:pass %graph-store (update:cg:gra (add-node index node)))^~
::
++ outgoing-add
|= =nodes
^- (quip card _state)
=/ nodes=(list [=index:store =node:store])
~(tap by nodes)
=| cards=(list card)
|- ^- (quip card _state)
?~ nodes [cards state]
?> ?=([@ @ ~] index.i.nodes)
=/ =ship i.index.i.nodes
=/ =dock [ship %dm-hook]
=/ =wire /dm/(scot %p ship)
=/ =cage
(update:cg:gra (add-node [index node]:i.nodes))
%= $
nodes t.nodes
pending (~(add ja pending) ship now.bowl)
::
cards
;: welp
cards
::
(add-missing-root ship)
::
:- (poke-our:pass %graph-store cage)
?: =(our.bowl ship) ~
(~(poke pass wire) dock cage)^~
==
==
::
++ normalize-incoming
|= =nodes
^- ^nodes
%- ~(gas by *^nodes)
%+ turn ~(tap by nodes)
|= [=index:store =node:store]
?> ?=([@ @ ~] index)
?> ?=(%empty -.children.node)
?> ?=(%& -.post.node)
=/ new-index=index:store
[src.bowl now.bowl ~]
=. index.p.post.node
new-index
[new-index node]
::
++ incoming-add
|= =nodes
^- (quip card _state)
:_ state
?> =(1 ~(wyt by nodes))
=* ship src.bowl
%+ snoc (add-missing-root ship)
%+ poke-our:pass %graph-store
%+ update:cg:gra now.bowl
[%add-nodes [our.bowl %dm-inbox] (normalize-incoming nodes)]
--
::
++ on-watch
|= =path
?. ?=([%updates ~] path)
(on-watch:def path)
:_ this
:~ (fact-init:io dm-hook-action+!>([%pendings ~(key by screened)]))
(fact-init:io dm-hook-action+!>([%screen screening]))
==
::
++ on-peek on-peek:def
++ on-leave on-leave:def
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
|^
?. ?=([%dm @ ~] wire)
(on-agent:def wire sign)
?> ?=(%poke-ack -.sign)
=/ =ship
(slav %p i.t.wire)
=^ acked=atom state
(remove-pending ship)
?~ p.sign
`this
:_ this
:_ ~
=+ indices=(~(gas in *(set index:store)) ~[ship acked] ~)
%+ poke-our:pass %graph-store
(update:cg:gra now.bowl %remove-posts [our.bowl %dm-inbox] indices)
::
++ remove-pending
|= =ship
^- [atom _state]
=/ pend-ship=(list atom)
(flop (~(get ja pending) ship))
?> ?=(^ pend-ship)
[i.pend-ship state(pending (~(put by pending) ship (flop t.pend-ship)))]
--
++ on-arvo on-arvo:def
++ on-fail on-fail:def
--

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

@ -875,7 +875,7 @@
%ge (dy-run-generator (dy-cage p.p.p.bil) q.p.bil)
%sa
=+ .^(=dais:clay cb+(en-beam he-beak /[p.bil]))
(dy-hand p.bil bunt:dais)
(dy-hand p.bil *vale:dais)
::
%as
=/ cag=cage (dy-cage p.q.bil)
@ -1162,6 +1162,7 @@
%import !!
%export-all !!
%import-all !!
%cancel !!
%as
:* %as mar.source.com
$(num +(num), source.com next.source.com)

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

@ -225,6 +225,7 @@
[~ %js] (js-response:gen file)
[~ %css] (css-response:gen file)
[~ %png] (png-response:gen file)
[~ %svg] (svg-response:gen file)
[~ %ico] (ico-response:gen file)
::
[~ %html]
@ -273,7 +274,10 @@
++ match-content-path
|= [pax=path =^serving is-file=?]
^- (unit [content path ?])
%- ~(rep by serving)
%+ roll
%+ sort ~(tap by serving)
|= [[a=path *] [b=path *]]
(gth (lent a) (lent b))
|= $: [url-base=path =content public=? spa=?]
out=(unit [content path ?])
==

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

@ -2,13 +2,16 @@
::
:: prompts content delivery and Gall state storage for Landscape JS blob
::
/- glob
/- glob, *resource
/+ default-agent, verb, dbug
|%
++ hash 0v4.vrvkt.4gcnm.dgg5o.e73d6.kqnaq
++ landscape-hash 0v4.3us6c.ma3il.h5bch.qacg3.70qjl
++ btc-wallet-hash 0v1.9p61c.bd4vn.deevh.0ldbq.fkqo3
+$ state-0 [%0 hash=@uv glob=(unit (each glob:glob tid=@ta))]
+$ state-1 [%1 =globs:glob]
+$ all-states
$% state-0
state-1
==
+$ card card:agent:gall
--
@ -19,12 +22,12 @@
[%pass [%timer path] %arvo %b %wait (add now ~m30)]
::
++ wait-start
|= now=@da
|= [now=@da =path]
^- card
[%pass /start %arvo %b %wait now]
[%pass [%start path] %arvo %b %wait now]
::
++ poke-file-server
|= [our=@p =cage]
|= [our=@p hash=@uv =cage]
^- card
[%pass /serving/(scot %uv hash) %agent [our %file-server] %poke cage]
::
@ -43,9 +46,12 @@
^- card
[%pass [%running path] %agent [our %spider] %leave ~]
--
=| state=state-0
=. hash.state hash
=/ serve-path=path /'~landscape'/js/bundle
=| state=state-1
=. globs.state
(~(put by globs.state) /'~landscape'/js/bundle landscape-hash ~)
=. globs.state
(~(put by globs.state) /'~btc'/js/bundle btc-wallet-hash ~)
::
^- agent:gall
%+ verb |
%- agent:dbug
@ -56,77 +62,121 @@
++ on-init
^- (quip card _this)
:: delay through timer to make sure %spider has started
[[(wait-start now.bowl) ~] this]
:_ this
%+ turn ~(tap by ~(key by globs.state))
|=(=path (wait-start now.bowl path))
::
++ on-save !>(state)
++ on-load
|= old-state=vase
^- (quip card _this)
=+ !<(old=all-states old-state)
?> ?=(%0 -.old)
?~ glob.old
on-init
?: ?=(%& -.u.glob.old)
?: =(hash.old hash.state)
`this(state old)
on-init
=/ cancel-cards
=/ args [tid.p.u.glob.old &]
:~ (leave-spider /(scot %uv hash.old) our.bowl)
(poke-spider /(scot %uv hash.old) our.bowl %spider-stop !>(args))
=| cards=(list card)
=/ upgrading=? %.n
|-
?- -.old
%1
=/ [cards-1=(list card) =globs:glob]
%- ~(rep by globs.old)
|= $: [=serve=path =glob-details:glob]
cards=(list card)
globs=_globs.state
==
^- [(list card) globs:glob]
=/ new-glob-details (~(get by globs) serve-path)
?~ new-glob-details
[cards globs]
?~ glob.glob-details
:_ globs
[(wait-start now.bowl serve-path) cards]
?: ?=(%& -.u.glob.glob-details)
?: =(hash.u.new-glob-details hash.glob-details)
[cards (~(put by globs) serve-path glob-details)]
:_ globs
[(wait-start now.bowl serve-path) cards]
?: upgrading
:_ globs
[(wait-start now.bowl serve-path) cards]
=/ args [tid.p.u.glob.glob-details &]
=/ spider-wire [(scot %uv hash.glob-details) serve-path]
:_ globs
:* (leave-spider spider-wire our.bowl)
(poke-spider spider-wire our.bowl %spider-stop !>(args))
(wait-start now.bowl serve-path)
cards
==
:- (weld cards cards-1)
this(globs.state globs)
::
%0
=/ globs
(~(put by globs.state) /'~landscape'/js/bundle [hash.old glob.old])
%= $
old [%1 globs]
::
cards
?~ glob.old ~
?: =(%& -.u.glob.old) ~
?> ?=(%| -.u.glob.old)
=/ args [tid.p.u.glob.old &]
:~ (leave-spider /(scot %uv hash.old) our.bowl)
(poke-spider /(scot %uv hash.old) our.bowl %spider-stop !>(args))
==
::
upgrading %.y
==
=^ init-cards this on-init
[(weld cancel-cards init-cards) this]
==
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
?+ mark (on-poke:def mark vase)
%glob-make
=+ !<(dir=path vase)
:_ this
=/ home=path /(scot %p our.bowl)/home/(scot %da now.bowl)
=+ .^(paths=(list path) %ct (weld home dir))
=+ .^(=js=tube:clay %cc (weld home /js/mime))
=+ .^(=map=tube:clay %cc (weld home /map/mime))
=+ .^(arch %cy (weld home /app/landscape/js/bundle))
=/ bundle-hash=@t
%- need
^- (unit @t)
%- ~(rep by dir)
|= [[file=@t ~] out=(unit @t)]
?^ out out
?. ?& =((end [3 6] file) 'index.')
!=('sj.' (end [3 3] (swp 3 file)))
==
out
``@t`(rsh [3 6] file)
=/ js-name
(cat 3 'index.' bundle-hash)
=/ map-name
(cat 3 js-name '.js')
=+ .^(js=@t %cx :(weld home /app/landscape/js/bundle /[js-name]/js))
=+ .^(map=@t %cx :(weld home /app/landscape/js/bundle /[map-name]/map))
=+ .^(sw=@t %cx :(weld home /app/landscape/js/bundle /serviceworker/js))
=+ !<(=js=mime (js-tube !>(js)))
=+ !<(=sw=mime (js-tube !>(sw)))
=+ !<(=map=mime (map-tube !>(map)))
=/ =glob:glob
%- ~(gas by *glob:glob)
:~ /[js-name]/js^js-mime
/[map-name]/map^map-mime
/serviceworker/js^sw-mime
%+ turn paths
|= pax=path
^- [path mime]
=+ .^(file=@t %cx (weld home pax))
=/ mar (snag 0 (flop pax))
:- (slag (lent dir) pax)
?+ mar ~|(unsupported-glob-type+mar !!)
%js !<(mime (js-tube !>(file)))
%map !<(mime (map-tube !>(file)))
==
=/ =path /(cat 3 'glob-' (scot %uv (sham glob)))/glob
~& globbed+`(set ^path)`~(key by glob)
[%pass /make %agent [our.bowl %hood] %poke %drum-put !>([path (jam glob)])]~
::
%noun
?: =(%kick q.vase)
(on-load !>(state(hash *@uv)))
?: =(%kick -.q.vase)
=+ !<([%kick =path] vase)
=/ glob-details (~(get by globs.state) path)
?~ glob-details
~& no-such-glob+path
`this
=/ new-state
state(globs (~(put by globs.state) path *@uv glob.u.glob-details))
(on-load !>(new-state))
(on-poke:def mark vase)
==
::
++ on-watch on-watch:def
++ on-leave on-leave:def
++ on-peek on-peek:def
::
++ on-peek
|= =path
^- (unit (unit cage))
?+ path (on-peek:def path)
[%x %btc-wallet ~] ``noun+!>(btc-wallet-hash)
==
::
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
@ -134,83 +184,109 @@
(on-agent:def wire sign)
?: ?=([%make ~] wire)
(on-agent:def wire sign)
?. ?=([%running @ ~] wire)
?. ?=([%running @ *] wire)
%- (slog leaf+"glob: strange on-agent! {<wire -.sign>}" ~)
(on-agent:def wire sign)
::
=/ produced-hash (slav %uv i.t.wire)
=* serve-path t.t.wire
=/ glob-details (~(get by globs.state) serve-path)
?~ glob-details
[~ this]
?. =(hash.u.glob-details produced-hash)
[~ this]
?- -.sign
%poke-ack
?~ p.sign
[~ this]
%- (slog leaf+"glob: couldn't start thread; will retry" u.p.sign)
:_ this(glob.state ~) :_ ~
(leave-spider t.wire our.bowl)
:_ this(globs.state (~(put by globs.state) serve-path produced-hash ~))
[(leave-spider t.wire our.bowl)]~
::
%watch-ack
?~ p.sign
[~ this]
%- (slog leaf+"glob: couldn't listen to thread; will retry" u.p.sign)
[~ this(glob.state ~)]
[~ this(globs.state (~(put by globs.state) serve-path produced-hash ~))]
::
%kick
=? glob.state ?=([~ %| *] glob.state)
~
`this
?. ?=([~ %| *] glob.u.glob-details)
`this
[~ this(globs.state (~(put by globs.state) serve-path produced-hash ~))]
::
%fact
=/ produced-hash (slav %uv i.t.wire)
?. =(hash.state produced-hash)
[~ this]
?+ p.cage.sign (on-agent:def wire sign)
%thread-fail
=+ !<([=term =tang] q.cage.sign)
%- (slog leaf+"glob: thread failed; will retry" leaf+<term> tang)
[~ this(glob.state ~)]
:- ~
this(globs.state (~(put by globs.state) serve-path produced-hash ~))
::
%thread-done
=+ !<(=glob:glob q.cage.sign)
?. =(hash.state (sham glob))
?. =(hash.u.glob-details (sham glob))
%: mean
leaf+"glob: hash doesn't match!"
>expected=hash.state<
>expected=hash.u.glob-details<
>got=(sham glob)<
~
==
:_ this(glob.state `[%& glob]) :_ ~
%+ poke-file-server our.bowl
[%file-server-action !>([%serve-glob serve-path glob %&])]
=. globs.state
(~(put by globs.state) serve-path produced-hash `[%& glob])
:_ this :_ ~
%: poke-file-server
our.bowl
produced-hash
%file-server-action
!>([%serve-glob serve-path glob %&])
==
==
==
::
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card _this)
?: ?=([%start ~] wire)
=/ new-tid=@ta (cat 3 'glob--' (scot %uv eny.bowl))
=/ args [~ `new-tid %glob !>([~ hash.state])]
=/ action !>([%unserve-dir serve-path])
:_ this(glob.state `[%| new-tid])
:~ (poke-file-server our.bowl %file-server-action action)
(wait-timeout /[new-tid] now.bowl)
(watch-spider /(scot %uv hash.state) our.bowl /thread-result/[new-tid])
(poke-spider /(scot %uv hash.state) our.bowl %spider-start !>(args))
?: ?=([%start *] wire)
=* serve-path t.wire
=/ glob-details (~(get by globs.state) serve-path)
?~ glob-details
[~ this]
=/ new-tid=@ta (cat 3 'glob--' (scot %uv (sham eny.bowl serve-path)))
=/ args [~ `new-tid %glob !>([~ hash.u.glob-details])]
=/ action=cage [%file-server-action !>([%unserve-dir serve-path])]
=/ spider-wire [(scot %uv hash.u.glob-details) serve-path]
=. globs.state
(~(put by globs.state) serve-path hash.u.glob-details `[%| new-tid])
:_ this
:~ (poke-file-server our.bowl hash.u.glob-details action)
(wait-timeout [new-tid serve-path] now.bowl)
(watch-spider spider-wire our.bowl /thread-result/[new-tid])
(poke-spider spider-wire our.bowl %spider-start !>(args))
==
?. ?=([%timer @ ~] wire)
::
?. ?=([%timer @ *] wire)
%- (slog leaf+"glob: strange on-arvo wire: {<wire [- +<]:sign-arvo>}" ~)
`this
?. ?=(%wake +<.sign-arvo)
%- (slog leaf+"glob: strange on-arvo sign: {<wire [- +<]:sign-arvo>}" ~)
`this
?: ?=([~ %& *] glob.state)
=* serve-path t.wire
=/ glob-details (~(get by globs.state) serve-path)
?~ glob-details
`this
?. ?| ?=(~ glob.state)
=(i.t.wire tid.p.u.glob.state)
?: ?=([~ %& *] glob.u.glob-details)
`this
?. ?| ?=(~ glob.u.glob-details)
=(i.t.wire tid.p.u.glob.u.glob-details)
==
`this
?^ error.sign-arvo
%- (slog leaf+"glob: timer handling failed; will retry" ~)
[[(wait-timeout t.wire now.bowl)]~ this]
%- (slog leaf+"glob: timed out; retrying" ~)
(on-load !>(state(hash *@uv)))
=/ new-details u.glob-details(hash *@uv)
=/ new-state state(globs (~(put by globs.state) serve-path new-details))
(on-load !>(new-state))
::
++ on-fail on-fail:def
--

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

@ -26,12 +26,18 @@
state-one
==
::
+$ cached-transform
$-([index:store post:store atom ?] [index:store post:store])
::
+$ cached-permission
$-(indexed-post:store $-(vip-metadata:metadata permissions:store))
::
:: TODO: come back to this and potentially use send a %t
:: to be notified of validator changes
+$ cache
$: graph-to-mark=(map resource:res (unit mark))
perm-marks=(map [mark @tas] tube:clay)
transform-marks=(map mark tube:clay)
perm-marks=(map [mark @tas] cached-permission)
transform-marks=(map mark cached-transform)
==
::
+$ inflated-state
@ -41,8 +47,8 @@
::
+$ cache-action
$% [%graph-to-mark (pair resource:res (unit mark))]
[%perm-marks (pair (pair mark @tas) tube:clay)]
[%transform-marks (pair mark tube:clay)]
[%perm-marks (pair (pair mark @tas) cached-permission)]
[%transform-marks (pair mark cached-transform)]
==
--
::
@ -119,13 +125,15 @@
?- -.q.update
%add-nodes
=| cards=(list card)
?: ?=(^ (rush name.rid ;~(pfix (jest 'dm--') fed:ag)))
:: block new DM messages
[~ ~]
=^ allowed cards (is-allowed-add:hc rid nodes.q.update)
?. allowed
[cards ~]
=/ mark-cached (~(has by graph-to-mark) rid)
=/ mark
?: mark-cached
(~(got by graph-to-mark) rid)
%+ fall
(~(get by graph-to-mark) rid)
(get-mark:gra rid)
?~ mark
[cards `vas]
@ -134,15 +142,12 @@
|%
++ $
^- (quip card (unit vase))
=/ transform-cached (~(has by transform-marks) u.mark)
=/ =tube:clay
?: transform-cached
(~(got by transform-marks) u.mark)
.^(tube:clay (scry:hc %cc %home /[u.mark]/transform-add-nodes))
=/ transform
!< $-([index:store post:store atom ?] [index:store post:store])
%. !>(*indexed-post:store)
tube
=/ transform=cached-transform
%+ fall
(~(get by transform-marks) u.mark)
=/ =tube:clay
.^(tube:clay (scry:hc %cc %home /[u.mark]/transform-add-nodes))
!<(cached-transform (tube !>(*indexed-post:store)))
=/ [* result=(list [index:store node:store])]
%+ roll
(flatten-node-map ~(tap by nodes.q.update))
@ -150,20 +155,24 @@
=. nodes.q.update
%- ~(gas by *(map index:store node:store))
result
:_ [~ !>(update)]
:_ :- ~
!> ^- update:store
update
%+ weld cards
%- zing
:~ ?: mark-cached ~
:~ ?: (~(has by graph-to-mark) rid)
~
:_ ~
%+ poke-self:pass:io %graph-cache-hook
!> ^- cache-action
[%graph-to-mark rid mark]
::
?: transform-cached ~
?: (~(has by transform-marks) u.mark)
~
:_ ~
%+ poke-self:pass:io %graph-cache-hook
!> ^- cache-action
[%transform-marks u.mark tube]
[%transform-marks u.mark transform]
==
::
++ flatten-node-map
@ -305,35 +314,31 @@
|= [=resource:res perm=@t vip=vip-metadata:metadata =indexed-post:store]
^- [permissions:store (list card)]
|^
=/ mark-cached (~(has by graph-to-mark.cache) resource)
=/ mark
?: mark-cached
(~(got by graph-to-mark.cache) resource)
%+ fall
(~(get by graph-to-mark.cache) resource)
(get-mark:gra resource)
?~ mark
[[%no %no %no] ~]
=/ key [u.mark (perm-mark-name perm)]
=/ perms-cached (~(has by perm-marks.cache) key)
=/ =tube:clay
?: perms-cached
(~(got by perm-marks.cache) key)
.^(tube:clay (scry %cc %home /[u.mark]/(perm-mark-name perm)))
=/ check
!< $-(vip-metadata:metadata permissions:store)
(tube !>(indexed-post))
:- (check vip)
=/ convert
%+ fall
(~(get by perm-marks.cache) key)
.^(cached-permission (scry %cf %home /[u.mark]/(perm-mark-name perm)))
:- ((convert indexed-post) vip)
%- zing
:~ ?: mark-cached ~
:~ ?: (~(has by graph-to-mark.cache) resource)
~
:_ ~
%+ poke-self:pass:io %graph-cache-hook
!> ^- cache-action
[%graph-to-mark resource mark]
::
?: perms-cached ~
?: (~(has by perm-marks.cache) key) ~
:_ ~
%+ poke-self:pass:io %graph-cache-hook
!> ^- cache-action
[%perm-marks [u.mark (perm-mark-name perm)] tube]
[%perm-marks [u.mark (perm-mark-name perm)] convert]
==
::
++ perm-mark-name

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

@ -1,13 +1,12 @@
:: graph-store [landscape]
::
::
/+ store=graph-store, sigs=signatures, res=resource, default-agent, dbug, verb
~% %graph-store-top ..part ~
|%
+$ card card:agent:gall
+$ versioned-state
$% [%0 network:zero:store]
[%1 network:zero:store]
$% [%0 *]
[%1 *]
[%2 network:zero:store]
[%3 network:one:store]
[%4 network:store]
@ -17,10 +16,9 @@
+$ state-5 [%5 network:store]
++ orm orm:store
++ orm-log orm-log:store
+$ debug-input [%validate-graph =resource:store]
::
+$ cache
$: validators=(map mark dais:clay)
$: validators=(map mark $-(indexed-post:store indexed-post:store))
==
::
:: TODO: come back to this and potentially use ford runes or otherwise
@ -51,34 +49,8 @@
=| cards=(list card)
|-
?- -.old
%0
=* zro zero-load:upgrade:store
%_ $
-.old %1
::
graphs.old
%- ~(run by graphs.old)
|= [=graph:zero:store q=(unit mark)]
^- [graph:zero:store (unit mark)]
:- (convert-unix-timestamped-graph:zro graph)
?^ q q
`%graph-validator-link
::
update-logs.old
%- ~(run by update-logs.old)
|=(a=* *update-log:zero:store)
==
::
%1
=* zro zero-load:upgrade:store
%_ $
-.old %2
graphs.old (~(run by graphs.old) change-revision-graph:zro)
::
update-logs.old
%- ~(run by update-logs.old)
|=(a=* *update-log:zero:store)
==
%0 !!
%1 !!
::
%2
=* upg upgrade:store
@ -139,7 +111,7 @@
++ give
|= =action:store
^- (list card)
[%give %fact ~ [%graph-update-2 !>([now.bowl action])]]~
[%give %fact ~ [%graph-update-2 !>(`update:store`[now.bowl action])]]~
--
::
++ on-poke
@ -149,10 +121,9 @@
|^
?> (team:title our.bowl src.bowl)
=^ cards state
?+ mark (on-poke:def mark vase)
%graph-update-2 (graph-update !<(update:store vase))
%noun (debug !<(debug-input vase))
%import (poke-import q.vase)
?+ mark (on-poke:def mark vase)
%graph-update-2 (graph-update !<(update:store vase))
%import (poke-import q.vase)
==
[cards this]
::
@ -205,7 +176,7 @@
==
%- zing
:~ (give [/keys ~] %keys (~(put in ~(key by graphs)) resource))
(give [/updates ~] %add-graph resource *graph:store mark overwrite)
(give [/updates ~] %add-graph resource ~ mark overwrite)
==
::
++ remove-graph
@ -275,7 +246,7 @@
?~ index
?=(^ node)
?~ t.index
?=(^ (get:orm graph i.index))
(has:orm graph i.index)
=. node (get:orm graph i.index)
?~ node %.n
?- -.children.u.node
@ -302,6 +273,11 @@
?~ node-list graph
=* index -.i.node-list
=* node +.i.node-list
~| "cannot add deleted post"
?> ?=(%& -.post.node)
=* p p.post.node
~| "graph indexes must match"
?> =(index index.p)
%_ $
node-list t.node-list
graph (add-node-at-index graph index node mark)
@ -326,7 +302,8 @@
~| "cannot add deleted post"
?> ?=(%& -.post.node)
=* p p.post.node
?~ hash.p node(signatures.p.post *signatures:store)
?~ hash.p
node(signatures.p.post ~)
=/ =validated-portion:store
[parent-hash author.p time-sent.p contents.p]
=/ =hash:store `@ux`(sham validated-portion)
@ -339,24 +316,23 @@
::
=/ parent=node:store
~| "index does not exist to add a node to!"
(need (get:orm graph atom))
(got:orm graph atom)
%_ parent
children
^- internal-graph:store
:- %graph
%_ $
index t.index
index t.index
::
parent-hash
?- -.post.parent
%| `p.post.parent
%& hash.p.post.parent
==
?: ?=(%| -.post.parent)
`p.post.parent
hash.p.post.parent
::
graph
?: ?=(%graph -.children.parent)
p.children.parent
(gas:orm ~ ~)
?. ?=(%graph -.children.parent)
~
p.children.parent
==
==
--
@ -412,7 +388,7 @@
?~ t.index
=/ =node:store
~| "cannot remove index that does not exist {<index>}"
(need (get:orm graph atom))
(got:orm graph atom)
%_ node
post
~| "cannot remove post that has already been removed"
@ -430,7 +406,7 @@
::
=/ parent=node:store
~| "parent index does not exist to remove a node from!"
(need (get:orm graph atom))
(got:orm graph atom)
~| "child index does not exist to remove a node from!"
?> ?=(%graph -.children.parent)
%_ parent
@ -440,10 +416,9 @@
graph p.children.parent
::
parent-hash
?- -.post.parent
%| `p.post.parent
%& hash.p.post.parent
==
?: ?=(%| -.post.parent)
`p.post.parent
hash.p.post.parent
==
==
--
@ -474,7 +449,7 @@
=* atom i.index
=/ =node:store
~| "node does not exist to add signatures to!"
(need (get:orm graph atom))
(got:orm graph atom)
:: last index in list
::
%^ put:orm
@ -486,7 +461,10 @@
~| "cannot add signatures to a node missing a hash"
?> ?=(^ hash.p.post.node)
~| "signatures did not match public keys!"
?> (are-signatures-valid:sigs our.bowl signatures u.hash.p.post.node now.bowl)
?> %: are-signatures-valid:sigs
our.bowl signatures
u.hash.p.post.node now.bowl
==
node(signatures.p.post (~(uni in signatures) signatures.p.post.node))
~| "child graph does not exist to add signatures to!"
?> ?=(%graph -.children.node)
@ -521,7 +499,7 @@
=* atom i.index
=/ =node:store
~| "node does not exist to add signatures to!"
(need (get:orm graph atom))
(got:orm graph atom)
:: last index in list
::
%^ put:orm
@ -574,7 +552,7 @@
%_ state
archive (~(del by archive) resource)
graphs (~(put by graphs) resource (~(got by archive) resource))
update-logs (~(put by update-logs) resource (gas:orm-log ~ ~))
update-logs (~(put by update-logs) resource ~)
==
::
++ run-updates
@ -595,50 +573,47 @@
%- graph-update
^- update:store
?- -.q.update
%add-graph update(resource.q resource)
%add-nodes update(resource.q resource)
%remove-posts update(resource.q resource)
%add-signatures update(resource.uid.q resource)
%remove-signatures update(resource.uid.q resource)
%add-graph update(resource.q resource)
%add-nodes update(resource.q resource)
%remove-posts update(resource.q resource)
%add-signatures update(resource.uid.q resource)
%remove-signatures update(resource.uid.q resource)
==
$(cards (weld cards crds), updates t.updates)
::
++ give
|= [paths=(list path) update=action:store]
^- (list card)
[%give %fact paths [%graph-update-2 !>([now.bowl update])]]~
[%give %fact paths [%graph-update-2 !>(`update:store`[now.bowl update])]]~
--
::
++ debug
|= =debug-input
^- (quip card _state)
=/ [=graph:store mark=(unit mark:store)]
(~(got by graphs) resource.debug-input)
=^ is-valid state
(validate-graph graph mark)
?> is-valid
[~ state]
::
++ validate-graph
|= [=graph:store mark=(unit mark:store)]
^- [? _state]
?~ mark [%.y state]
=/ has-dais (~(has by validators) u.mark)
=/ =dais:clay
?: has-dais
(~(got by validators) u.mark)
.^ =dais:clay
%cb
/(scot %p our.bowl)/[q.byk.bowl]/(scot %da now.bowl)/[u.mark]
?~ mark
[%.y state]
=/ validate=$-(indexed-post:store indexed-post:store)
%+ fall
(~(get by validators) u.mark)
.^ $-(indexed-post:store indexed-post:store)
%cf
(scot %p our.bowl)
q.byk.bowl
(scot %da now.bowl)
u.mark
%graph-indexed-post
~
==
:_ state(validators (~(put by validators) u.mark dais))
=? validators !(~(has by validators) u.mark)
(~(put by validators) u.mark validate)
:_ state
|- ^- ?
?~ graph %.y
%+ roll (tap:orm graph)
|= [[=atom =node:store] out=?]
%+ all:orm graph
|= [=atom =node:store]
^- ?
?& ?| ?=(%| -.post.node)
?=(^ (vale:dais [atom p.post.node]))
?=(^ (validate [atom p.post.node]))
==
::
?- -.children.node
@ -667,7 +642,7 @@
=/ result=(unit marked-graph:store)
(~(get by graphs) [ship term])
?~ result [~ ~]
``noun+!>(q.u.result)
``noun+!>(`(unit mark)`q.u.result)
::
[%x %keys ~]
:- ~ :- ~ :- %graph-update-2
@ -724,7 +699,7 @@
:+ %add-nodes
[ship term]
%- ~(gas by *(map index:store node:store))
%+ turn (tap:orm `graph:store`(subset:orm p.u.graph start end))
%+ turn (tap:orm `graph:store`(lot:orm p.u.graph start end))
|= [=atom =node:store]
^- [index:store node:store]
[~[atom] node]
@ -736,7 +711,7 @@
(turn t.t.t.t.path (cury slav %ud))
=/ node=(unit node:store)
(get-node ship term index)
``noun+!>(?=(^ node))
``noun+!>(`?`?=(^ node))
::
[%x %node @ @ @ *]
=/ =ship (slav %p i.t.t.path)
@ -753,6 +728,7 @@
(~(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
@ -770,18 +746,45 @@
:+ %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 -))
?: older
(tab:orm u.graph `(rear index) count)
:: TODO time complexity not desirable for %younger case
::
%+ slag (safe-sub (lent -) count)
%- tap:orm
%+ subset:orm u.graph
=/ idx
(snag (dec (lent index)) index)
?:(older [`idx ~] [~ `idx])
%+ lot:orm u.graph
[~ `(snag (dec (lent index)) index)]
|= [=atom =node:store]
^- [index:store node:store]
[(snoc parent atom) node]
::
++ safe-sub
|= [a=@ b=@]
^- @
?: (gte b a)
0
(sub a b)
--
::
[%x %shallow-children @ @ *]
=/ =ship (slav %p i.t.t.path)
=/ =term i.t.t.t.path
=/ =index:store
(turn t.t.t.t.path (cury slav %ud))
=/ children
(get-node-children ship term index)
?~ children [~ ~]
:- ~ :- ~ :- %graph-update-2
!> ^- update:store
:+ now.bowl %add-nodes
:- [ship term]
%- ~(gas by *(map index:store node:store))
%+ turn (tap:orm u.children)
|= [=atom =node:store]
^- [index:store node:store]
:- (snoc index atom)
node(children [%empty ~])
::
[%x ?(%newest %oldest) @ @ @ *]
=/ newest ?=(%newest i.t.path)
@ -802,8 +805,9 @@
%- ~(gas by *(map index:store node:store))
%+ turn
%+ scag count
%- ?:(newest same flop)
(tap:orm u.children)
?: newest
(tap:orm u.children)
(bap:orm u.children)
|= [=atom =node:store]
^- [index:store node:store]
[(snoc index atom) node]
@ -826,11 +830,116 @@
:+ %add-nodes
[ship term]
%- ~(gas by *(map index:store node:store))
%+ turn (tap:orm `graph:store`(subset:orm p.children.u.node end start))
%+ turn (tap:orm `graph:store`(lot:orm p.children.u.node end start))
|= [=atom =node:store]
^- [index:store node:store]
[(snoc index atom) node]
==
::
[%x %deep-nodes-older-than @ @ @ @ ~]
=/ =ship (slav %p i.t.t.path)
=/ =term i.t.t.t.path
=/ count=(unit atom) (rush i.t.t.t.t.path dem:ag)
=/ start=(unit atom) (rush i.t.t.t.t.t.path dem:ag)
?: ?=(~ count)
[~ ~]
=/ result=(unit marked-graph:store)
(~(get by graphs) [ship term])
?~ result
[~ ~]
:- ~ :- ~ :- %graph-update-2
!> ^- update:store
:- now.bowl
:+ %add-nodes
[ship term]
=* a u.count
=/ b=(list (pair atom node:store))
(tab:orm p.u.result start u.count)
=| c=index:store
=| d=(map index:store node:store)
=| e=@ud
=- d
|- ^- [e=@ud d=(map index:store node:store)]
?: ?|(?=(~ b) =(e a))
[e d]
=* atom p.i.b
=* node q.i.b
=. c (snoc c atom)
?- -.children.node
%empty
$(b t.b, e +(e), d (~(put by d) c node), c (snip c))
::
%graph
=/ f $(b (tab:orm p.children.node ~ (sub a e)))
?: =(e.f a) f
%_ $
b t.b
e +(e.f)
d (~(put by d.f) c node(children [%empty ~]))
c (snip c)
==
==
::
[%x %firstborn @ @ @ *]
|^
=/ =ship (slav %p i.t.t.path)
=/ =term i.t.t.t.path
=/ =index:store
(turn t.t.t.t.path (cury slav %ud))
?> ?=(^ index)
=/ result=(unit marked-graph:store)
(~(get by graphs) [ship term])
?~ result
[~ ~]
%- (bond |.(`(unit (unit cage))`[~ ~]))
%+ biff
(collect-parents p.u.result index ship term)
(corl some collect-firstborn)
::
++ collect-parents
|= [=graph:store =index:store =ship =term]
^- %- unit
[node:store index:store (map index:store node:store) ^ship ^term]
=| =(map index:store node:store)
=| =node:store
=| ind=index:store
=/ len (lent index)
|-
?: (gte (lent ind) len)
`[node ind map ship term]
?> ?=(^ index)
=* atom i.index
?. (has:orm graph atom)
~
=: node (got:orm graph atom)
ind (snoc ind atom)
==
?: ?=(%empty -.children.node)
?. (gte (lent ind) len)
~
:- ~
:* node ind
(~(put by map) ind node)
ship term
==
%_ $
index t.index
graph p.children.node
map (~(put by map) ind node(children empty+~))
==
::
++ collect-firstborn
|= [=node:store =index:store mp=(map index:store node:store) =ship =term]
^- (unit (unit cage))
?: ?=(%empty -.children.node)
:- ~ :- ~ :- %graph-update-2
!> ^- update:store
[now.bowl [%add-nodes [ship term] mp]]
=/ item=[k=atom v=node:store]
(need (ram:orm p.children.node))
=. index (snoc index k.item)
$(mp (~(put by mp) index v.item(children empty+~)), node v.item)
--
::
[%x %update-log-subset @ @ @ @ ~]
=/ =ship (slav %p i.t.t.path)
@ -840,35 +949,29 @@
=/ update-log=(unit update-log:store) (~(get by update-logs) [ship term])
?~ update-log [~ ~]
:: orm-log is ordered backwards, so swap start and end
``noun+!>((subset:orm-log u.update-log end start))
``noun+!>(`update-log:store`(lot:orm-log u.update-log end start))
::
[%x %update-log @ @ ~]
=/ =ship (slav %p i.t.t.path)
=/ =term i.t.t.t.path
=/ update-log=(unit update-log:store) (~(get by update-logs) [ship term])
?~ update-log [~ ~]
``noun+!>(u.update-log)
``noun+!>(`update-log:store`u.update-log)
::
[%x %peek-update-log @ @ ~]
=/ =ship (slav %p i.t.t.path)
=/ =term i.t.t.t.path
=/ m-update-log=(unit update-log:store) (~(get by update-logs) [ship term])
=/ m-update-log=(unit update-log:store)
(~(get by update-logs) [ship term])
:- ~ :- ~ :- %noun
!> ^- (unit time)
%+ biff m-update-log
|= =update-log:store
=/ result=(unit [=time =update:store])
(peek:orm-log:store update-log)
(bind result |=([=time update:store] time))
(pry:orm-log:store update-log)
(bind result head)
==
::
++ safe-sub
|= [a=@ b=@]
^- @
?: (gte b a)
0
(sub a b)
::
++ get-node-children
|= [=ship =term =index:store]
^- (unit graph:store)
@ -911,40 +1014,12 @@
?+ wire (on-arvo:def wire sign-arvo)
::
:: old wire, do nothing
[%graph *] [~ this]
[%validator @ ~] [~ this]
::
[%try-rejoin @ *]
=/ rid=resource:store (de-path:res t.t.wire)
=/ nack-count (slav %ud i.t.wire)
?> ?=([%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]
:_ this
[%pass new %agent [entity.rid %graph-push-hook] %watch resource+t.t.wire]~
[%graph *] [~ this]
[%validator @ ~] [~ this]
[%try-rejoin @ *] [~ this]
==
::
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
?. ?=([%try-rejoin @ *] wire)
(on-agent:def wire sign)
?. ?=(%watch-ack -.sign)
[~ this]
=/ rid=resource:store (de-path:res t.t.wire)
?~ p.sign
=/ =cage [%pull-hook-action !>([%add entity.rid rid])]
:_ this
:~ [%pass / %agent [our.bowl %graph-pull-hook] %poke cage]
[%pass wire %agent [entity.rid %graph-push-hook] %leave ~]
==
=/ nack-count=@ud (slav %ud i.t.wire)
=/ wakeup=@da
(add now.bowl (mul ~s1 (bex (min 19 nack-count))))
:_ this
[%pass wire %arvo %b %wait wakeup]~
::
++ on-agent on-agent:def
++ on-leave on-leave:def
++ on-fail on-fail:def
--

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

@ -136,13 +136,13 @@
^- (unit (unit cage))
?+ path (on-peek:def path)
[%y %groups ~]
``noun+!>(~(key by groups))
``noun+!>(`(set resource)`~(key by groups))
::
[%x %groups %ship @ @ ~]
=/ rid=(unit resource)
(de-path-soft:resource t.t.path)
?~ rid ~
``noun+!>((peek-group u.rid))
``noun+!>(`(unit group)`(peek-group u.rid))
::
[%x %groups %ship @ @ %join @ ~]
=/ rid=(unit resource)
@ -150,7 +150,7 @@
=/ =ship
(slav %p i.t.t.t.t.t.t.path)
?~ rid ~
``noun+!>((peek-group-join u.rid ship))
``noun+!>(`?`(peek-group-join u.rid ship))
::
[%x %export ~]
``noun+!>(state)
@ -199,6 +199,7 @@
::
++ peek-group-join
|= [rid=resource =ship]
^- ?
=/ ugroup
(~(get by groups) rid)
?~ ugroup

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

@ -30,12 +30,12 @@
?> ?=(^ t.p)
.^(mold i.p (scot %p our) i.t.p (scot %da now) t.t.p)
::
++ scry-conversion
++ scry-notif-conversion
|= [[our=@p now=@da] desk=term =mark]
~+
^- $-(indexed-post:graph-store (unit notif-kind:hook))
%^ scry [our now]
tube:clay
/cc/[desk]/[mark]/notification-kind
$-(indexed-post:graph-store (unit notif-kind:hook))
/cf/[desk]/[mark]/notification-kind
--
::
=| state-1
@ -87,7 +87,7 @@
|= =mark
^- card
=/ =wire /validator/[mark]
=/ =rave:clay [%sing %c [%da now.bowl] /[mark]/notification-kind]
=/ =rave:clay [%sing %f [%da now.bowl] /[mark]/notification-kind]
[%pass wire %arvo %c %warp our.bowl [%home `rave]]
::
++ on-watch
@ -214,19 +214,18 @@
%- ~(gas by *(set [resource index:graph-store]))
(turn ~(tap in indices) (lead rid))
:_ state(watching (~(dif in watching) to-remove))
=/ =tube:clay
(get-conversion:ha rid)
=/ convert (get-conversion:ha rid)
%+ roll
~(tap in indices)
|= [=index:graph-store out=(list card)]
=| =indexed-post:graph-store
=. index.p.indexed-post index
=+ !<(u-notif-kind=(unit notif-kind:hook) (tube !>(indexed-post)))
?~ u-notif-kind out
=* notif-kind u.u-notif-kind
=/ notif-kind=(unit notif-kind:hook)
(convert indexed-post)
?~ notif-kind out
=/ =stats-index:store
[%graph rid (scag parent.index-len.notif-kind index)]
?. ?=(%each mode.notif-kind) out
[%graph rid (scag parent.index-len.u.notif-kind index)]
?. ?=(%each mode.u.notif-kind) out
:_ out
(poke-hark %read-each stats-index index)
::
@ -256,7 +255,7 @@
=/ 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))
(bind (pry:orm:graph-store graph) |=([@ =node:graph-store] node))
=/ assoc=(unit association:metadata)
(peek-association:met %graph rid)
=^ cards state
@ -271,16 +270,7 @@
rid=resource
assoc=(unit association:metadata)
==
?~ assoc
~& no-assoc+rid
`state
=* group group.u.assoc
=* metadatum metadatum.u.assoc
=/ module=term
?: ?=(%empty -.config.metadatum) %$
?: ?=(%group -.config.metadatum) %$
module.config.metadatum
abet:check:(abed:handle-update:ha rid nodes group module)
abet:check:(abed:handle-update:ha rid nodes)
--
::
++ on-peek on-peek:def
@ -294,7 +284,7 @@
[%validator @ ~]
:_ this
=* validator i.t.wire
=/ =rave:clay [%next %c [%da now.bowl] /[validator]/notification-kind]
=/ =rave:clay [%next %f [%da now.bowl] /[validator]/notification-kind]
[%pass wire %arvo %c %warp our.bowl [%home `rave]]~
==
++ on-fail on-fail:def
@ -307,13 +297,13 @@
::
++ get-conversion
|= rid=resource
^- tube:clay
^- $-(indexed-post:graph-store (unit notif-kind:hook))
=+ %^ 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)
|=(=indexed-post:graph-store ~)
(scry-notif-conversion [our now]:bowl q.byk.bowl u.mark)
::
++ give
|= [paths=(list path) =update:hook]
@ -345,28 +335,25 @@
|= [rid=resource assoc=(unit association:metadata)]
^- ?
?~ assoc
%.n
?| !(is-managed:grp group.u.assoc)
&(watch-on-self =(our.bowl entity.rid))
==
%.y
&(watch-on-self =(our.bowl entity.rid))
::
++ handle-update
|_ $: rid=resource :: input
updates=(list node:graph-store)
group=resource
module=term
mark=(unit mark)
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)
|= [r=resource upds=(list node:graph-store)]
=/ m=(unit ^mark)
(get-mark:gra r)
update-core(rid r, updates upds, mark m)
::
++ get-conversion
:: LA: this tube should be cached in %hark-graph-hook state
:: instead of just trying to keep it warm, as the scry overhead is large
~+ (^get-conversion rid)
::
++ abet
@ -420,9 +407,8 @@
?: ?=(%| -.post.node)
update-core
=* pos p.post.node
=+ !< notif-kind=(unit notif-kind:hook)
%- get-conversion
!>(`indexed-post:graph-store`[0 pos])
=/ notif-kind=(unit notif-kind:hook)
(get-conversion [0 pos])
?~ notif-kind
update-core
=/ desc=@t
@ -433,7 +419,7 @@
=/ parent=index:post
(scag parent.index-len.not-kind index.pos)
=/ notif-index=index:store
[%graph group rid module desc parent]
[%graph rid mark desc parent]
?: =(our.bowl author.pos)
(self-post node notif-index not-kind)
=. update-core
@ -441,6 +427,7 @@
=? update-core
?| =(desc %mention)
(~(has in watching) [rid parent])
=(mark `%graph-validator-dm)
==
=/ =contents:store
[%graph (limo pos ~)]

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

@ -25,6 +25,7 @@
state-4
state-5
state-6
state-7
==
+$ unread-stats
[indices=(set index:graph-store) last=@da]
@ -32,6 +33,8 @@
+$ base-state
$: unreads-each=(jug stats-index:store index:graph-store)
unreads-count=(map stats-index:store @ud)
timeboxes=(map stats-index:store @da)
unread-notes=timebox:store
last-seen=(map stats-index:store @da)
=notifications:store
archive=notifications:store
@ -52,23 +55,16 @@
[%5 state-three:store]
::
+$ state-6
[%6 base-state]
[%6 state-four:store]
::
+$ state-7
[%7 base-state]
::
+$ inflated-state
$: state-6
cache
==
:: $cache: useful to have precalculated, but can be derived from state
:: albeit expensively
+$ cache
$: by-index=(jug stats-index:store [time=@da =index:store])
~
==
::
++ orm ((ordered-map @da timebox:store) gth)
--
::
=| inflated-state
=| state-7
=* state -
::
=<
@ -87,26 +83,43 @@
:_ this
~[autoseen-timer]
::
++ on-save !>(-.state)
++ on-save !>(state)
++ on-load
|= =old=vase
^- (quip card _this)
=/ old
!<(versioned-state old-vase)
=| cards=(list card)
|^
|^
^- (quip card _this)
?- -.old
%6
%7
:- (flop cards)
this(-.state old, +.state (inflate-cache:ha old))
this(state old)
::
%6
%_ $
-.old %7
::
%5
+.old
%* . *base-state
notifications (notifications:to-five:upgrade:store notifications.old)
archive ~
unreads-each unreads-each.old
unreads-count unreads-count.old
last-seen last-seen.old
current-timebox current-timebox
dnd dnd.old
==
==
::
%5
%_ $
-.old %6
notifications.old (convert-notifications-4 notifications.old)
archive.old (convert-notifications-4 archive.old)
notifications.old (notifications:to-four:upgrade:store notifications.old)
archive.old *notifications:state-four:store
==
::
::
%4
%_ $
-.old %5
@ -115,14 +128,14 @@
%- ~(run by last-seen.old)
|=(old=@da (min old now.bowl))
==
::
::
%3
%_ $
-.old %4
notifications.old (convert-notifications-3 notifications.old)
archive.old (convert-notifications-3 archive.old)
notifications.old (notifications:to-three:upgrade:store notifications.old)
archive.old *notifications:state-three:store
==
::
::
%2
%_ $
-.old %3
@ -131,7 +144,7 @@
:_ cards
[%pass / %agent [our dap]:bowl %poke noun+!>(%fix-dangling)]
==
::
::
%1
%_ $
::
@ -146,7 +159,7 @@
dnd dnd.old
==
==
::
::
%0
%_ $
::
@ -160,98 +173,6 @@
==
==
::
++ convert-notifications-4
|= old=notifications:state-three:store
%+ gas:orm *notifications:store
^- (list [@da timebox:store])
%+ murn
(tap:orm:state-three:store old)
|= [time=@da =timebox:state-three:store]
^- (unit [@da timebox:store])
=/ new-timebox=timebox:store
(convert-timebox-4 timebox)
?: =(0 ~(wyt by new-timebox))
~
`[time new-timebox]
::
++ convert-timebox-4
|= =timebox:state-three:store
^- timebox:store
%- ~(gas by *timebox:store)
^- (list [index:store notification:store])
%+ murn
~(tap by timebox)
|= [=index:store =notification:state-three:store]
^- (unit [index:store notification:store])
=/ new-notification=(unit notification:store)
(convert-notification-4 notification)
?~ new-notification ~
`[index u.new-notification]
::
++ convert-notification-4
|= =notification:state-three:store
^- (unit notification:store)
?: ?=(%group -.contents.notification)
`notification
=/ con=(list post:post)
(convert-graph-contents-4 list.contents.notification)
?: =(~ con) ~
=, notification
`[date read %graph con]
::
++ convert-graph-contents-4
|= con=(list post:post-zero:post)
^- (list post:post)
(turn con post-to-one:upgrade:graph-store)
::
++ convert-notifications-3
|= old=notifications:state-two:store
%+ gas:orm:state-three:store *notifications:state-three:store
^- (list [@da timebox:state-three:store])
%+ murn
(tap:orm:state-two:store old)
|= [time=@da =timebox:state-two:store]
^- (unit [@da timebox:state-three:store])
=/ new-timebox=timebox:state-three:store
(convert-timebox-3 timebox)
?: =(0 ~(wyt by new-timebox))
~
`[time new-timebox]
::
++ convert-timebox-3
|= =timebox:state-two:store
^- timebox:state-three:store
%- ~(gas by *timebox:state-three:store)
^- (list [index:state-three:store notification:state-three:store])
%+ murn
~(tap by timebox)
|= [=index:store =notification:state-two:store]
^- (unit [index:store notification:state-three:store])
=/ new-notification=(unit notification:state-three:store)
(convert-notification-3 notification)
?~ new-notification ~
`[index u.new-notification]
::
++ convert-notification-3
|= =notification:state-two:store
^- (unit notification:state-three:store)
?: ?=(%graph -.contents.notification)
`notification
=/ con=(list group-contents:store)
(convert-group-contents-3 list.contents.notification)
?: =(~ con) ~
=, notification
`[date read %group con]
::
++ convert-group-contents-3
|= con=(list group-contents:state-two:store)
^- (list group-contents:store)
%+ murn con
|= =group-contents:state-two:store
^- (unit group-contents:store)
?. ?=(?(%add-members %remove-members) -.group-contents) ~
`group-contents
::
++ uni-by
|= [a=(set index:graph-store) b=(set index:graph-store)]
=/ merged
@ -291,12 +212,12 @@
|= =timebox:state-zero:store
^- timebox:state-two:store
%- ~(gas by *timebox:state-two:store)
^- (list [index:store notification:state-two:store])
^- (list [index:state-two:store notification:state-two:store])
%+ murn
~(tap by timebox)
|= [=index:state-zero:store =notification:state-zero:store]
^- (unit [index:store notification:state-two:store])
=/ new-index=(unit index:store)
^- (unit [index:state-two:store notification:state-two:store])
=/ new-index=(unit index:state-two:store)
(convert-index-1 index)
=/ new-notification=(unit notification:state-two:store)
(convert-notification-1 notification)
@ -306,13 +227,13 @@
::
++ convert-index-1
|= =index:state-zero:store
^- (unit index:store)
^- (unit index:state-two:store)
?+ -.index `index
%chat ~
::
%graph
=, index
`[%graph group graph module description ~]
`[%graph graph *resource module description ~]
==
::
++ convert-notification-1
@ -339,8 +260,14 @@
^- update:store
:- %more
^- (list update:store)
:- give-unreads
[%set-dnd dnd]~
:~ give-unreads
[%set-dnd dnd]
give-notifications
==
::
++ give-notifications
^- update:store
[%timebox ~ ~(tap by unread-notes)]
::
++ give-since-unreads
^- (list [stats-index:store stats:store])
@ -348,7 +275,6 @@
~(tap by unreads-count)
|= [=stats-index:store count=@ud]
:* stats-index
(~(gut by by-index) stats-index ~)
[%count count]
(~(gut by last-seen) stats-index *time)
==
@ -359,31 +285,16 @@
~(tap by unreads-each)
|= [=stats-index:store indices=(set index:graph-store)]
:* stats-index
(~(gut by by-index) stats-index ~)
[%each indices]
(~(gut by last-seen) stats-index *time)
==
::
++ give-group-unreads
^- (list [stats-index:store stats:store])
%+ murn ~(tap by by-index)
|= [=stats-index:store nots=(set [time index:store])]
?. ?=(%group -.stats-index)
~
:- ~
:* stats-index
nots
[%count 0]
*time
==
::
++ give-unreads
^- update:store
:- %unreads
;: weld
give-each-unreads
give-since-unreads
give-group-unreads
==
--
::
@ -409,8 +320,7 @@
?:(is-archive archive notifications)
|= [time=@da =timebox:store]
^- update:store
:^ %timebox time is-archive
~(tap by timebox)
[%timebox `time ~(tap by timebox)]
==
::
++ on-poke
@ -471,9 +381,7 @@
^- (quip card _this)
?. ?=([%autoseen ~] wire)
(on-arvo:def wire sign-arvo)
?> ?=([%behn %wake *] sign-arvo)
:_ this(current-timebox now.bowl)
~[autoseen-timer:ha]
`this
::
++ on-fail on-fail:def
--
@ -512,10 +420,13 @@
%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)
%read-graph (read-graph +.in)
%read-group (read-group +.in)
::
%set-dnd (set-dnd +.in)
%seen seen
%read-all read-all
@ -525,13 +436,6 @@
:: +| %note
::
:: notification tracking
++ upd-cache
|= [read=? time=@da =index:store]
poke-core(+.state (^upd-cache read time index))
::
++ rebuild-cache
poke-core(+.state (inflate-cache -.state))
::
++ put-notifs
|= [time=@da =timebox:store]
poke-core(notifications (put:orm notifications time timebox))
@ -539,74 +443,60 @@
++ add-note
|= [=index:store =notification:store]
^+ poke-core
=/ existing-notif
(~(get by unread-notes) index)
=/ new=notification:store
(merge-notification existing-notif notification)
=. unread-notes
(~(put by unread-notes) index new)
=/ timebox=@da
(~(gut by timeboxes) (to-stats-index:store index) current-timebox)
(give %added index new)
::
++ do-archive
|= [time=(unit @da) =index:store]
^+ poke-core
|^
?~(time archive-unread (archive-read u.time))
::
++ archive-unread
=. unread-notes
(~(del by unread-notes) index)
(give %archive ~ index)
::
++ archive-read
|= time=@da
=/ =timebox:store
(gut-orm notifications time)
=/ =notification:store
(~(got by timebox) index)
=/ new-timebox=timebox:store
(~(del by timebox) index)
=. poke-core
(put-notifs time new-timebox)
(give %archive `time index)
--
::
++ read-note
|= =index:store
=/ =notification:store
(~(got by unread-notes) index)
=. unread-notes
(~(del by unread-notes) index)
=/ =time
(~(gut by timeboxes) (to-stats-index:store index) current-timebox)
=/ =timebox:store
(gut-orm notifications current-timebox)
(gut-orm notifications time)
=/ 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
=. timebox
(~(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)
::
:: if we detect cache inconsistencies, wipe and rebuild
++ change-read-status
|= [time=@da =index:store read=?]
^+ poke-core
=. poke-core (upd-cache read time index)
=/ tib=(unit timebox:store)
(get:orm notifications time)
?~ tib poke-core
=/ not=(unit notification:store)
(~(get by u.tib) index)
?~ not poke-core
=? poke-core
:: cache is inconsistent iff we didn't directly
:: call this through %read-note or %unread-note
&(=(read read.u.not) !?=(?(%read-note %unread-note) -.in))
~& >> "Inconsistent hark cache, rebuilding"
rebuild-cache
?< &(=(read read.u.not) ?=(?(%read-note %unread-note) -.in))
=. u.tib
(~(put by u.tib) index u.not(read read))
=. notifications
(put:orm notifications time u.tib)
poke-core
(put:orm notifications time timebox)
(give %note-read time index)
::
++ 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
::
@ -624,18 +514,18 @@
|= [=stats-index:store ref=index:graph-store]
%- read-indices
%+ skim
~(tap ^in (~(get ju by-index) stats-index))
|= [time=@da =index:store]
=/ =timebox:store
(gut-orm notifications time)
~(tap ^in ~(key by unread-notes))
|= =index:store
?. (stats-index-is-index:store stats-index index) %.n
=/ not=notification:store
(~(got by timebox) index)
(~(got by unread-notes) index)
?. ?=(%graph -.index) %.n
?. ?=(%graph -.contents.not) %.n
(lien list.contents.not |=(p=post:post =(index.p ref)))
::
++ read-each
|= [=stats-index:store ref=index:graph-store]
=. timeboxes (~(put by timeboxes) stats-index now.bowl)
=. poke-core (read-index-each stats-index ref)
%+ jub-unreads-each:(give %read-each stats-index ref)
stats-index
@ -659,12 +549,13 @@
++ read-count
|= =stats-index:store
=. unreads-count (~(put by unreads-count) stats-index 0)
=/ times=(list [@da index:store])
~(tap ^in (~(get ju by-index) stats-index))
=/ times=(list index:store)
(unread-for-stats-index stats-index)
=? timeboxes !(~(has by timeboxes) stats-index) (~(put by timeboxes) stats-index now.bowl)
(give:(read-indices times) %read-count stats-index)
::
++ read-indices
|= times=(list [time=@da =index:store])
|= times=(list =index:store)
|-
?~ times poke-core
=/ core
@ -679,10 +570,53 @@
(~(put by last-seen) stats-index new-time)
(give %seen-index new-time stats-index)
::
++ get-stats-indices
|= rid=resource
%- ~(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))
==
|= =stats-index:store
?. ?=(%graph -.stats-index) %.n
=(graph.stats-index rid)
::
++ read-all-each
|= =stats-index:store
=/ refs=(list index:graph-store)
~(tap ^in (~(get ju unreads-each) stats-index))
|-
?~ refs poke-core
$(refs t.refs, poke-core (read-each stats-index i.refs))
::
++ read-graph
|= rid=resource
=/ indices=(list stats-index:store)
~(tap ^in (get-stats-indices rid))
|-
?~ indices poke-core
=* index i.indices
=? poke-core (~(has by unreads-count) index)
(read-count i.indices)
=? poke-core (~(has by unreads-each) index)
(read-all-each i.indices)
$(indices t.indices)
::
++ read-group
|= rid=resource
=/ graphs=(list resource)
(graphs-of-group:met rid)
|-
?~ graphs poke-core
=/ core=_poke-core (read-graph i.graphs)
$(graphs t.graphs, poke-core core)
::
++ remove-graph
|= rid=resource
|^
=/ indices get-stats-indices
=/ indices (get-stats-indices rid)
=. poke-core
(give %remove-graph rid)
=. poke-core
@ -694,23 +628,8 @@
unreads-each indices
=. last-seen
((dif-map-by-key ,@da) last-seen indices)
=. by-index
((dif-map-by-key ,(set [@da =index:store])) 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)]
@ -728,30 +647,35 @@
~(tap ^in set)
|-
?~ indices poke-core
=/ times=(list [time=@da =index:store])
~(tap ^in (~(get ju by-index) i.indices))
=/ times=(list =index:store)
(unread-for-stats-index i.indices)
=. poke-core
(read-indices times)
$(indices t.indices)
--
::
++ seen
=> (emit cancel-autoseen)
=> (emit autoseen-timer)
poke-core(current-timebox now.bowl)
=. poke-core
(read-indices ~(tap ^in ~(key by unread-notes)))
poke-core(current-timebox now.bowl, timeboxes ~)
::
++ read-all
=: unreads-count (~(run by unreads-count) _0)
unreads-each (~(run by unreads-each) _~)
notifications (~(run by notifications) _~)
==
(give:seen:rebuild-cache %read-all ~)
(give:seen %read-all ~)
::
++ set-dnd
|= d=?
(give:poke-core(dnd d) %set-dnd d)
--
::
++ unread-for-stats-index
|= =stats-index:store
%+ skim ~(tap in ~(key by unread-notes))
(cury stats-index-is-index:store stats-index)
::
++ merge-notification
|= [existing=(unit notification:store) new=notification:store]
^- notification:store
@ -760,11 +684,11 @@
::
%graph
?> ?=(%graph -.contents.new)
u.existing(read %.n, list.contents (weld list.contents.u.existing list.contents.new))
u.existing(list.contents (weld list.contents.u.existing list.contents.new))
::
%group
?> ?=(%group -.contents.new)
u.existing(read %.n, list.contents (weld list.contents.u.existing list.contents.new))
u.existing(list.contents (weld list.contents.u.existing list.contents.new))
==
::
:: +key-orm: +key:by for ordered maps
@ -818,38 +742,4 @@
^- (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
%. [(to-stats-index:store index) time index]
?: read
~(del ju by-index)
~(put ju by-index)
==
::
++ inflate-cache
|= state-6
^+ +.state
=. +.state
*cache
=/ nots=(list [p=@da =timebox:store])
(tap:orm notifications)
|- =* outer $
?~ nots +.state
=/ unreads ~(tap by timebox.i.nots)
|- =* inner $
?~ unreads
outer(nots t.nots)
=* notification q.i.unreads
=* index p.i.unreads
?: read.notification
inner(unreads t.unreads)
=. +.state
(upd-cache %.n p.i.nots index)
inner(unreads t.unreads)
--

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

@ -15,7 +15,11 @@
[%9 drum=state:drum helm=state:helm kiln=state:kiln]
[%10 drum=state:drum helm=state:helm kiln=state:kiln]
[%11 drum=state:drum helm=state:helm kiln=state:kiln]
<<<<<<< HEAD
[%12 drum=any-state:drum helm=state:helm kiln=state:kiln]
=======
[%12 drum=state:drum helm=state:helm kiln=state:kiln]
>>>>>>> cd400dfa69059e211dc88f4ce5d53479b9da7542
==
+$ any-state-tuple
$: drum=any-state:drum

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

@ -24,6 +24,6 @@
<div id="portal-root"></div>
<script src="/~landscape/js/channel.js"></script>
<script src="/~landscape/js/session.js"></script>
<script src="/~landscape/js/bundle/index.f252a9afb6e952de19c9.js"></script>
<script src="/~landscape/js/bundle/index.af45eeaf465dff7d73f1.js"></script>
</body>
</html>

35
pkg/arvo/app/launch.hoon
View File

@ -13,16 +13,23 @@
[%4 state-zero]
[%5 state-zero]
[%6 state-zero]
[%7 state-7]
==
::
+$ state-zero
$: tiles=tiles-0:store
=tile-ordering:store
first-time=?
==
::
+$ state-7
$: =tiles:store
=tile-ordering:store
first-time=?
==
--
::
=| [%6 state-zero]
=| [%7 state-7]
=* state -
%- agent:dbug
^- agent:gall
@ -32,7 +39,7 @@
::
++ on-init
^- (quip card _this)
=/ new-state *state-zero
=/ new-state *state-7
=. new-state
%_ new-state
tiles
@ -41,12 +48,12 @@
|= =term
:- term
^- tile:store
?+ term [[%custom ~] %.y]
?+ term [[%custom ~ ~] %.y]
%term [[%basic 'Terminal' '/~landscape/img/term.png' '/~term'] %.y]
==
tile-ordering [%weather %clock %term ~]
==
[~ this(state [%6 new-state])]
[~ this(state [%7 new-state])]
::
++ on-save !>(state)
++ on-load
@ -55,8 +62,22 @@
=/ old-state !<(versioned-state old)
=| cards=(list card)
|- ^- (quip card _this)
?: ?=(%6 -.old-state)
?: ?=(%7 -.old-state)
[cards this(state old-state)]
::
?: ?=(%6 -.old-state)
=/ new-tiles=tiles:store
%- ~(gas by *tiles:store)
%+ turn ~(tap by tiles.old-state)
|= [=term =tile-0:store]
:- term
:_ is-shown.tile-0
?- -.type.tile-0
%basic type.tile-0
%custom [%custom ~ ~]
==
$(old-state [%7 new-tiles tile-ordering.old-state first-time.old-state])
::
?: ?=(%5 -.old-state)
:: replace %dojo with %term
::
@ -86,11 +107,11 @@
=. new-state
%_ new-state
tiles
%- ~(gas by *tiles:store)
%- ~(gas by *tiles-0:store)
%+ turn `(list term)`[%weather %clock %dojo ~]
|= =term
:- term
^- tile:store
^- tile-0:store
?+ term [[%custom ~] %.y]
%dojo [[%basic 'Dojo' '/~landscape/img/Dojo.png' '/~dojo'] %.y]
==

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

@ -1,5 +1,5 @@
/- lens, *sole
/+ *server, default-agent
/+ *server, default-agent, dbug
/= lens-mark /mar/lens/command :: TODO: ask clay to build a $tube
=, format
|%
@ -35,6 +35,8 @@
--
::
=| =state
%- agent:dbug
^- agent:gall
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
@ -56,8 +58,6 @@
?. ?=(%handle-http-request mark)
(on-poke:def mark vase)
=+ !<([eyre-id=@ta =inbound-request:eyre] vase)
?> ?=(~ job.state)
::
=/ request-line (parse-request-line url.request.inbound-request)
=/ site (flop site.request-line)
::
@ -76,6 +76,13 @@
=/ com=command:lens
(json:grab:lens-mark jon)
::
?: ?=(%cancel -.source.com)
~& %lens-cancel
:_ this(job.state ~)
(give-simple-payload:app eyre-id (json-response:gen [%s 'cancelled']))
::
?> ?=(~ job.state)
::
?+ -.source.com
:_ this(job.state (some [eyre-id com]))
[%pass /sole %agent [our.bowl %dojo] %watch /sole/[eyre-id]]~

58
pkg/arvo/app/metadata-push-hook.hoon
View File

@ -2,7 +2,7 @@
::
/- *group, *invite-store, store=metadata-store
/+ default-agent, verb, dbug, grpl=group, push-hook,
resource, mdl=metadata, gral=graph
resource, mdl=metadata, gral=graph, agentio
~% %group-hook-top ..part ~
|%
+$ card card:agent:gall
@ -18,9 +18,19 @@
==
::
+$ agent (push-hook:push-hook config)
::
+$ state-null ~
+$ state-zero [%0 ~]
::
+$ versioned-state
$% state-null
state-zero
==
--
::
::
=| state-zero
=* state -
%- agent:dbug
%+ verb |
^- agent:gall
@ -32,23 +42,45 @@
grp ~(. grpl bowl)
met ~(. mdl bowl)
gra ~(. gral bowl)
io ~(. agentio bowl)
pass pass:io
::
++ on-init on-init:def
++ on-save !>(~)
++ on-load on-load:def
++ on-load on-load:def
::
++ on-poke
|= [=mark =vase]
?. ?=(%metadata-hook-update mark)
(on-poke:def mark vase)
=+ !<(=hook-update:store vase)
?. ?=(%req-preview -.hook-update)
(on-poke:def mark vase)
?> =(entity.group.hook-update our.bowl)
=/ =group-preview:store
(get-preview:met group.hook-update)
:_ this
=- [%pass / %agent [src.bowl %metadata-pull-hook] %poke -]~
metadata-hook-update+!>(`hook-update:store`[%preview group-preview])
|^ ^- (quip card _this)
?+ mark (on-poke:def mark vase)
%metadata-hook-update metadata-hook-update
%noun noun
==
::
++ metadata-hook-update
=+ !<(=hook-update:store vase)
?. ?=(%req-preview -.hook-update)
(on-poke:def mark vase)
?> =(entity.group.hook-update our.bowl)
=/ =group-preview:store
(get-preview:met group.hook-update)
:_ this
=- [%pass / %agent [src.bowl %metadata-pull-hook] %poke -]~
metadata-hook-update+!>(`hook-update:store`[%preview group-preview])
::
++ noun
?+ q.vase ~|("unknown noun poke" !!)
::
%clean-dm
=+ .^(sharing=(set resource) (scry:io %gx dap.bowl /sharing/noun))
:_ this
%+ murn ~(tap in sharing)
|= rid=resource
^- (unit card)
?@ (rush name.rid ;~(pfix (jest 'dm--') fed:ag)) ~
`(poke-self:pass push-hook-action+!>([%remove rid]))
==
--
::
++ on-agent on-agent:def
++ on-watch on-watch:def

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

@ -106,6 +106,7 @@
+$ state-8 [%8 base-state-3]
+$ state-9 [%9 base-state-3]
+$ state-10 [%10 base-state-3]
+$ state-11 [%11 base-state-3]
+$ versioned-state
$% state-0
state-1
@ -118,10 +119,11 @@
state-8
state-9
state-10
state-11
==
::
+$ inflated-state
$: state-10
$: state-11
cached-indices
==
--
@ -192,28 +194,35 @@
|= =path
^- (unit (unit cage))
?+ path (on-peek:def path)
[%y %group-indices ~] ``noun+!>(group-indices)
[%y %app-indices ~] ``noun+!>(app-indices)
[%y %resource-indices ~] ``noun+!>(resource-indices)
[%x %associations ~] ``noun+!>(associations)
[%y %group-indices ~]
``noun+!>(`(jug resource md-resource:store)`group-indices)
::
[%y %app-indices ~]
``noun+!>(`(jug app-name:store [group=resource =resource])`app-indices)
::
[%y %resource-indices ~]
``noun+!>(`(map md-resource:store resource)`resource-indices)
::
[%x %associations ~]
``noun+!>(`associations:store`associations)
::
[%x %app-name @ ~]
=/ =app-name:store i.t.t.path
``noun+!>((metadata-for-app:mc app-name))
``noun+!>(`associations:store`(metadata-for-app:mc app-name))
::
[%x %group *]
=/ group=resource (de-path:resource t.t.path)
``noun+!>((metadata-for-group:mc group))
``noun+!>(`associations:store`(metadata-for-group:mc group))
::
[%x %metadata @ @ @ @ ~]
=/ =md-resource:store
[i.t.t.path (de-path:resource t.t.t.path)]
``noun+!>((~(get by associations) md-resource))
``noun+!>(`(unit association:store)`(~(get by associations) md-resource))
::
[%x %resource @ *]
=/ app=term i.t.t.path
=/ rid=resource (de-path:resource t.t.t.path)
``noun+!>((~(get by resource-indices) [app rid]))
``noun+!>(`(unit resource)`(~(get by resource-indices) [app rid]))
::
[%x %export ~]
``noun+!>(-.state)
@ -234,7 +243,7 @@
=| cards=(list card)
|^
=* loop $
?: ?=(%10 -.old)
?: ?=(%11 -.old)
:- cards
%_ state
associations associations.old
@ -242,6 +251,8 @@
group-indices (rebuild-group-indices associations.old)
app-indices (rebuild-app-indices associations.old)
==
?: ?=(%10 -.old)
$(-.old %11, associations.old (hide-dm-assoc associations.old))
?: ?=(%9 -.old)
=/ groups
(fall (~(get by (rebuild-app-indices associations.old)) %groups) ~)
@ -282,6 +293,20 @@
:: pre-breach, can safely throw away
loop(old *state-8)
::
++ hide-dm-assoc
|= assoc=associations:store
^- associations:store
%- ~(gas by *associations:store)
%+ turn ~(tap by assoc)
|= [m=md-resource:store [g=resource met=metadatum:store]]
^- [md-resource:store association:store]
=? hidden.met
?& ?=(^ (rush name.resource.m ;~(pfix (jest 'dm--') fed:ag)))
?=(%graph app-name.m)
==
%.y
[m [g met]]
::
++ associations-2-to-3
|= assoc=associations-2
^- associations:store
@ -483,7 +508,7 @@
::
++ metadata-for-app
|= =app-name:store
^+ associations
^- associations:store
%+ roll ~(tap in (~(gut by app-indices) app-name ~))
|= [[group=resource rid=resource] out=associations:store]
=/ =md-resource:store
@ -494,6 +519,7 @@
::
++ metadata-for-group
|= group=resource
^- associations:store
=/ resources=(set md-resource:store)
(~(get ju group-indices) group)
%+ roll

10
pkg/arvo/app/settings-store.hoon
View File

@ -83,13 +83,13 @@
^- (unit (unit cage))
?+ pax (on-peek:def pax)
[%x %all ~]
``settings-data+!>(all+settings)
``settings-data+!>(`data`all+settings)
::
[%x %bucket @ ~]
=* buc i.t.t.pax
=/ bucket=(unit bucket) (~(get by settings) buc)
?~ bucket [~ ~]
``settings-data+!>(bucket+u.bucket)
``settings-data+!>(`data`bucket+u.bucket)
::
[%x %entry @ @ ~]
=* buc i.t.t.pax
@ -97,19 +97,19 @@
=/ =bucket (fall (~(get by settings) buc) ~)
=/ entry=(unit val) (~(get by bucket) key)
?~ entry [~ ~]
``settings-data+!>(entry+u.entry)
``settings-data+!>(`data`entry+u.entry)
::
[%x %has-bucket @ ~]
=* buc i.t.t.pax
=/ has-bucket=? (~(has by settings) buc)
``noun+!>(has-bucket)
``noun+!>(`?`has-bucket)
::
[%x %has-entry @ @ ~]
=* buc i.t.t.pax
=* key i.t.t.t.pax
=/ =bucket (fall (~(get by settings) buc) ~)
=/ has-entry=? (~(has by bucket) key)
``noun+!>(has-entry)
``noun+!>(`?`has-entry)
==
::
++ on-agent on-agent:def

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

@ -1,6 +1,7 @@
/- spider
/+ libstrand=strand, default-agent, verb, server
=, strand=strand:libstrand
~% %spider-top ..part ~
|%
+$ card card:agent:gall
+$ thread thread:spider
@ -60,6 +61,7 @@
::
:: Trie operations
::
~% %spider ..card ~
|%
++ get-yarn
|= [=trie =yarn]
@ -137,6 +139,7 @@
=| =state
=<
%+ verb |
~% %spider-agent ..bind-eyre ~
|_ =bowl:gall
+* this .
spider-core +>
@ -192,6 +195,7 @@
--
::
++ on-poke
~/ %on-poke
|= [=mark =vase]
^- (quip card _this)
?: ?=(%spider-kill mark)
@ -208,6 +212,7 @@
[cards this]
::
++ on-watch
~/ %on-watch
|= =path
^- (quip card _this)
=^ cards state
@ -220,6 +225,7 @@
::
++ on-leave on-leave:def
++ on-peek
~/ %on-peek
|= =path
^- (unit (unit cage))
?+ path (on-peek:def path)
@ -234,6 +240,7 @@
==
::
++ on-agent
~/ %on-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
=^ cards state
@ -243,6 +250,7 @@
[cards this]
::
++ on-arvo
~/ %on-arvo
|= [=wire =sign-arvo]
^- (quip card _this)
=^ cards state
@ -261,6 +269,7 @@
(on-load on-save)
--
::
~% %spider-helper ..get-yarn ~
|_ =bowl:gall
::
++ bind-eyre
@ -272,6 +281,7 @@
:((cury cat 3) file '--' (scot %uv (sham eny.bowl)))
::
++ handle-http-request
~/ %handle-http-request
|= [eyre-id=@ta =inbound-request:eyre]
^- (quip card _state)
?> authenticated.inbound-request
@ -284,6 +294,8 @@
=/ =tid (new-thread-id thread)
=. serving.state
(~(put by serving.state) tid [eyre-id output-mark])
:: TODO: speed this up somehow. we spend about 15ms in this arm alone
::
=+ .^
=tube:clay
%cc
@ -315,6 +327,7 @@
`state
::
++ handle-sign
~/ %handle-sign
|= [=tid =wire =sign-arvo]
=/ yarn (~(get by tid.state) tid)
?~ yarn
@ -331,6 +344,7 @@
(take-input u.yarn ~ %agent wire sign)
::
++ handle-start-thread
~/ %handle-start-thread
|= [parent-tid=(unit tid) use=(unit tid) file=term =vase]
^- (quip card ^state)
=/ parent-yarn=yarn
@ -353,12 +367,13 @@
=/ pax=path
~| no-file-for-thread+file
(need (get-fit:clay [our q.byk da+now]:bowl %ted file))
=/ =card
:+ %pass /build/[new-tid]
[%arvo %c %warp our.bowl %home ~ %sing %a da+now.bowl pax]
[[card ~] state]
:_ state
:_ ~
:+ %pass /build/[new-tid]
[%arvo %c %warp our.bowl %home ~ %sing %a da+now.bowl pax]
::
++ handle-build
~/ %handle-build
|= [=tid =sign-arvo]
^- (quip card ^state)
=/ =yarn (~(got by tid.state) tid)
@ -377,6 +392,7 @@
(start-thread yarn p.maybe-thread)
::
++ start-thread
~/ %start-thread
|= [=yarn =thread]
^- (quip card ^state)
=/ =vase vase:(~(got by starting.state) yarn)
@ -411,6 +427,7 @@
(thread-fail u.yarn %cancelled ~)
::
++ take-input
~/ %take-input
|= [=yarn input=(unit input:strand)]
^- (quip card ^state)
=/ m (strand ,vase)

13
pkg/arvo/gen/btc-provider/action.hoon Normal file
View File

@ -0,0 +1,13 @@
:: Sends a raw RPC action to the BTC Provider
::
:: Commands:
::
::
::
/- *btc-provider
::
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[act=action ~] ~]
==
[%btc-provider-action act]

13
pkg/arvo/gen/btc-provider/command.hoon Normal file
View File

@ -0,0 +1,13 @@
:: Sends a command to the BTC Provider
::
:: Commands:
::
::
::
/- *btc-provider
::
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[comm=command ~] ~]
==
[%btc-provider-command comm]

5
pkg/arvo/gen/btc-wallet-check.hoon Normal file
View File

@ -0,0 +1,5 @@
:- %say
|= [[now=time * bec=beak] ~ ~]
:- %noun
:- %btc-wallet-hash
.^(@uv %gx (en-beam bec(q %glob) /btc-wallet/noun))

9
pkg/arvo/gen/btc-wallet/action.hoon Normal file
View File

@ -0,0 +1,9 @@
:: Sends an action to btc-wallet
::
/- *btc-wallet
::
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[act=action ~] ~]
==
[%btc-wallet-action act]

9
pkg/arvo/gen/btc-wallet/command.hoon Normal file
View File

@ -0,0 +1,9 @@
:: Sends a command to btc-wallet
::
/- *btc-wallet
::
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[comm=command ~] ~]
==
[%btc-wallet-command comm]

21
pkg/arvo/gen/dm-hook/dm.hoon Normal file
View File

@ -0,0 +1,21 @@
:: dm-hook|dm: DM somebody
::
/- *graph-store
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[him=ship contents=(list content) ~] ~]
==
=* our p.beak
=/ =post *post
=: author.post our
index.post ~[him now]
time-sent.post now
contents.post contents
==
::
:- %graph-update-2
^- update
:- now
:+ %add-nodes [our %dm-inbox]
%- ~(gas by *(map index node))
~[[~[him now] [%&^post [%empty ~]]]]

4
pkg/arvo/gen/glob/make.hoon
View File

@ -1,3 +1,3 @@
:- %say
|= *
[%glob-make ~]
|= [^ [=path ~] ~]
[%glob-make path]

15
pkg/arvo/gen/hood/fuse.hoon Normal file
View File

@ -0,0 +1,15 @@
:: Kiln: Fuse local desk from (optionally-)foreign sources
::
:::: /hoon/fuse/hood/gen
::
/* help-text %txt /gen/hood/fuse/help/txt
=, clay
::
::::
::
:- %say
|= [[now=@da eny=@uvJ bec=beak] [arg=[?(~ [des=desk bas=beak con=(list [beak germ]) ~])]] ~]
:- %kiln-fuse
?~ arg
((slog (turn `wain`help-text |=(=@t leaf+(trip t)))) ~)
[des bas con]:arg

8
pkg/arvo/gen/hood/fuse/help.txt Normal file
View File

@ -0,0 +1,8 @@
Usage:
|fuse %destination-desk base-beak ~[[source-beak %some-germ] [another-beak %another-germ]]
A fuse replaces the contents of %destination-desk with the merge of the
specified beaks according to their merge strategies. This has no dependence
on the previous state of %destination-desk so any commits/work there will
be overwritten.

7
pkg/arvo/gen/kick.hoon Normal file
View File

@ -0,0 +1,7 @@
:: Kick subs
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
~
~
==
[%kick %kick]

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

@ -1,5 +1,5 @@
/- gr=group, md=metadata-store, ga=graph-store
/+ re=resource
/+ re=resource, graph=graph-store
!:
:- %say
|= $: [now=@da eny=@uvJ =beak]
@ -86,9 +86,9 @@
%+ scry update:ga
[%x %graph-store /graph/(scot %p entity.r)/[name.r]/noun]
?> ?=(%add-graph -.q.upd)
=/ mo ((ordered-map atom node:ga) gth)
=* mo orm:graph
=/ week=(list [@da node:ga])
(tap:mo (subset:mo graph.q.upd ~ `(sub now ~d7)))
(tap:mo (lot:mo graph.q.upd ~ `(sub now ~d7)))
:- (lent week)
%~ wyt in
%+ roll week

12
pkg/arvo/gen/trouble.hoon
View File

@ -9,6 +9,7 @@
:: children
:: glob-hash: hash of the glob, which is the js for landscape
::
/- glob
/+ version
:- %say
|= [[now=time * bec=beak] ~ ~]
@ -65,8 +66,11 @@
.^(@uv %cz /[parent]/[desk.u.ota]/(scot %ud ud.cass))
::
++ glob-state
^- [@uv @tas]
=< [hash ?~(glob %waiting ?:(-.u.glob %done %trying))]
!< [@ud hash=@uv glob=(unit [? *])]
.^(vase %gx (weld (pathify ~.glob ~) /dbug/state/noun))
^- (list [path @uv @tas])
=+ !< [@ud =globs:glob]
.^(vase %gx (weld (pathify ~.glob ~) /dbug/state/noun))
%+ turn ~(tap by globs)
|= [srv=path hash=@uv glob=(unit [? *])]
^- [path @uv @tas]
[srv hash ?~(glob %waiting ?:(-.u.glob %done %trying))]
--

249
pkg/arvo/lib/bip/b158.hoon Normal file
View File

@ -0,0 +1,249 @@
/- bc=bitcoin
/+ bcu=bitcoin-utils
|%
++ params
|%
++ p 19
++ m 784.931
--
::
++ siphash
|= [k=byts m=byts]
^- byts
|^
?> =(wid.k 16)
?> (lte (met 3 dat.k) wid.k)
?> (lte (met 3 dat.m) wid.m)
=. k (flim:sha k)
=. m (flim:sha m)
(flim:sha (fin (comp m (init dat.k))))
:: Initialise internal state
::
++ init
|= k=@
^- [@ @ @ @]
=/ k0=@ (end [6 1] k)
=/ k1=@ (cut 6 [1 1] k)
:^ (mix k0 0x736f.6d65.7073.6575)
(mix k1 0x646f.7261.6e64.6f6d)
(mix k0 0x6c79.6765.6e65.7261)
(mix k1 0x7465.6462.7974.6573)
::
:: Compression rounds
++ comp
|= [m=byts v=[v0=@ v1=@ v2=@ v3=@]]
^- [@ @ @ @]
=/ len=@ud (div wid.m 8)
=/ last=@ (lsh [3 7] (mod wid.m 256))
=| i=@ud
=| w=@
|-
=. w (cut 6 [i 1] dat.m)
?: =(i len)
=. v3.v (mix v3.v (mix last w))
=. v (rnd (rnd v))
=. v0.v (mix v0.v (mix last w))
v
%= $
v =. v3.v (mix v3.v w)
=. v (rnd (rnd v))
=. v0.v (mix v0.v w)
v
i (add i 1)
==
::
:: Finalisation rounds
++ fin
|= v=[v0=@ v1=@ v2=@ v3=@]
^- byts
=. v2.v (mix v2.v 0xff)
=. v (rnd (rnd (rnd (rnd v))))
:- 8
:(mix v0.v v1.v v2.v v3.v)
::
:: Sipround
++ rnd
|= [v0=@ v1=@ v2=@ v3=@]
^- [@ @ @ @]
=. v0 (~(sum fe 6) v0 v1)
=. v2 (~(sum fe 6) v2 v3)
=. v1 (~(rol fe 6) 0 13 v1)
=. v3 (~(rol fe 6) 0 16 v3)
=. v1 (mix v1 v0)
=. v3 (mix v3 v2)
=. v0 (~(rol fe 6) 0 32 v0)
=. v2 (~(sum fe 6) v2 v1)
=. v0 (~(sum fe 6) v0 v3)
=. v1 (~(rol fe 6) 0 17 v1)
=. v3 (~(rol fe 6) 0 21 v3)
=. v1 (mix v1 v2)
=. v3 (mix v3 v0)
=. v2 (~(rol fe 6) 0 32 v2)
[v0 v1 v2 v3]
--
:: +str: bit streams
:: read is from the front
:: write appends to the back
::
++ str
|%
++ read-bit
|= s=bits:bc
^- [bit=@ub rest=bits:bc]
?> (gth wid.s 0)
:* ?:((gth wid.s (met 0 dat.s)) 0b0 0b1)
[(dec wid.s) (end [0 (dec wid.s)] dat.s)]
==
::
++ read-bits
|= [n=@ s=bits:bc]
^- [bits:bc rest=bits:bc]
=| bs=bits:bc
|-
?: =(n 0) [bs s]
=^ b s (read-bit s)
$(n (dec n), bs (write-bits bs [1 b]))
::
++ write-bits
|= [s1=bits:bc s2=bits:bc]
^- bits:bc
[(add wid.s1 wid.s2) (can 0 ~[s2 s1])]
--
:: +gol: Golomb-Rice encoding/decoding
::
++ gol
|%
:: +en: encode x and append to end of s
:: - s: bits stream
:: - x: number to add to the stream
:: - p: golomb-rice p param
::
++ en
|= [s=bits:bc x=@ p=@]
^- bits:bc
=+ q=(rsh [0 p] x)
=+ unary=[+(q) (lsh [0 1] (dec (bex q)))]
=+ r=[p (end [0 p] x)]
%+ write-bits:str s
(write-bits:str unary r)
::
++ de
|= [s=bits:bc p=@]
^- [delta=@ rest=bits:bc]
|^ ?> (gth wid.s 0)
=^ q s (get-q s)
=^ r s (read-bits:str p s)
[(add dat.r (lsh [0 p] q)) s]
::
++ get-q
|= s=bits:bc
=| q=@
=^ first-bit s (read-bit:str s)
|-
?: =(0 first-bit) [q s]
=^ b s (read-bit:str s)
$(first-bit b, q +(q))
--
--
:: +hsh
::
++ hsh
|%
:: +to-range
:: - item: scriptpubkey to hash
:: - f: N*M
:: - k: key for siphash (end of blockhash, reversed)
::
++ to-range
|= [item=byts f=@ k=byts]
^- @
(rsh [0 64] (mul f (swp 3 dat:(siphash k item))))
:: +set-construct: return sorted hashes of scriptpubkeys
::
++ set-construct
|= [items=(list byts) k=byts f=@]
^- (list @)
%+ sort
%+ turn items
|= item=byts
(to-range item f k)
lth
--
::
++ parse-filter
|= filter=hexb:bc
^- [n=@ux gcs-set=bits:bc]
=/ n n:(de:csiz:bcu filter)
=/ lead=@ ?:(=(1 wid.n) 1 +(wid.n))
:- dat.n
[(mul 8 (sub wid.filter lead)) `@ub`dat:(drop:byt:bcu lead filter)]
:: +to-key: blockhash (little endian) to key for siphash
::
++ to-key
|= blockhash=tape
^- byts
%+ take:byt:bcu 16
%- flip:byt:bcu
(from-cord:hxb:bcu (crip blockhash))
:: +match: whether block filter matches *any* target scriptpubkeys
:: - filter: full block filter, with leading N
:: - k: key for siphash (end of blockhash, reversed)
:: - targets: scriptpubkeys to match
::
++ match
|= [filter=hexb:bc k=byts targets=(list byts)]
^- ?
=/ [p=@ m=@] [p:params m:params]
=/ [n=@ux gcs-set=bits:bc] (parse-filter filter)
=+ target-hs=(set-construct:hsh targets k (mul n m))
=+ last-val=0
|-
?~ target-hs %.n
?: =(last-val i.target-hs)
%.y
?: (gth last-val i.target-hs)
$(target-hs t.target-hs)
:: last-val is less than target: check next val in GCS, if any
::
?: (lth wid.gcs-set p) %.n
=^ delta gcs-set
(de:gol gcs-set p)
$(last-val (add delta last-val))
:: +all-match: returns all target byts that match
:: - filter: full block filter, with leading N
:: - targets: scriptpubkeys to match
::
++ all-match
|= [filter=hexb:bc blockhash=hexb:bc targets=(list [address:bc byts])]
^- (set [address:bc hexb:bc])
=/ k (to-key (trip (to-cord:hxb:bcu blockhash)))
%- ~(gas in *(set [address:bc hexb:bc]))
=/ [p=@ m=@] [p:params m:params]
=/ [n=@ux gcs-set=bits:bc] (parse-filter filter)
=/ target-map=(map @ [address:bc hexb:bc])
%- ~(gas by *(map @ [address:bc hexb:bc]))
%+ turn targets
|= [a=address:bc t=hexb:bc]
[(to-range:hsh t (mul n m) k) a t]
=+ target-hs=(sort ~(tap in ~(key by target-map)) lth)
=+ last-val=0
=| matches=(list @)
|-
?~ target-hs
(murn matches ~(get by target-map))
?: =(last-val i.target-hs)
%= $
target-hs t.target-hs
matches [last-val matches]
==
?: (gth last-val i.target-hs)
$(target-hs t.target-hs)
:: last-val is less than target: get next val in GCS, if any
::
?: (lth wid.gcs-set p)
(murn matches ~(get by target-map))
=^ delta gcs-set
(de:gol gcs-set p)
$(last-val (add delta last-val))
::
--

144
pkg/arvo/lib/bip/b173.hoon Normal file
View File

@ -0,0 +1,144 @@
:: BIP173: Bech32 Addresses
:: https://github.com/bitcoin/bips/blob/master/bip-0173.mediawiki
::
:: Heavily copies:
:: https://github.com/bitcoinjs/bech32/blob/master/index.js
::
/- sur=bitcoin
/+ bcu=bitcoin-utils
=, sur
=, bcu
|%
++ prefixes
^- (map network tape)
(my [[%main "bc"] [%testnet "tb"] ~])
++ charset "qpzry9x8gf2tvdw0s3jn54khce6mua7l"
+$ raw-decoded [hrp=tape data=(list @) checksum=(list @)]
:: below is a port of: https://github.com/bitcoinjs/bech32/blob/master/index.js
::
++ polymod
|= values=(list @)
|^ ^- @
=/ gen=(list @ux)
~[0x3b6a.57b2 0x2650.8e6d 0x1ea1.19fa 0x3d42.33dd 0x2a14.62b3]
=/ chk=@ 1
|- ?~ values chk
=/ top (rsh [0 25] chk)
=. chk
(mix i.values (lsh [0 5] (dis chk 0x1ff.ffff)))
$(values t.values, chk (update-chk chk top gen))
::
++ update-chk
|= [chk=@ top=@ gen=(list @ux)]
=/ is (gulf 0 4)
|- ?~ is chk
?: =(1 (dis 1 (rsh [0 i.is] top)))
$(is t.is, chk (mix chk (snag i.is gen)))
$(is t.is)
--
::
++ expand-hrp
|= hrp=tape
^- (list @)
=/ front (turn hrp |=(p=@tD (rsh [0 5] p)))
=/ back (turn hrp |=(p=@tD (dis 31 p)))
(zing ~[front ~[0] back])
::
++ verify-checksum
|= [hrp=tape data-and-checksum=(list @)]
^- ?
%- |=(a=@ =(1 a))
%- polymod
(weld (expand-hrp hrp) data-and-checksum)
::
++ checksum
|= [hrp=tape data=(list @)]
^- (list @)
:: xor 1 with the polymod
::
=/ pmod=@
%+ mix 1
%- polymod
(zing ~[(expand-hrp hrp) data (reap 6 0)])
%+ turn (gulf 0 5)
|=(i=@ (dis 31 (rsh [0 (mul 5 (sub 5 i))] pmod)))
::
++ charset-to-value
|= c=@tD
^- (unit @)
(find ~[c] charset)
++ value-to-charset
|= value=@
^- (unit @tD)
?: (gth value 31) ~
`(snag value charset)
::
++ is-valid
|= [bech=tape last-1-pos=@] ^- ?
?& ?|(=((cass bech) bech) =((cuss bech) bech)) :: to upper or to lower is same as bech
(gte last-1-pos 1)
(lte (add last-1-pos 7) (lent bech))
(lte (lent bech) 90)
(levy bech |=(c=@tD (gte c 33)))
(levy bech |=(c=@tD (lte c 126)))
==
:: data should be 5bit words
::
++ encode-raw
|= [hrp=tape data=(list @)]
^- cord
=/ combined=(list @)
(weld data (checksum hrp data))
%- crip
(zing ~[hrp "1" (tape (murn combined value-to-charset))])
++ decode-raw
|= body=cord
^- (unit raw-decoded)
=/ bech (cass (trip body)) :: to lowercase
=/ pos (flop (fand "1" bech))
?~ pos ~
=/ last-1=@ i.pos
?. (is-valid bech last-1) :: check bech32 validity (not segwit validity or checksum)
~
=/ hrp (scag last-1 bech)
=/ encoded-data-and-checksum=(list @)
(slag +(last-1) bech)
=/ data-and-checksum=(list @)
%+ murn encoded-data-and-checksum
charset-to-value
?. =((lent encoded-data-and-checksum) (lent data-and-checksum)) :: ensure all were in CHARSET
~
?. (verify-checksum hrp data-and-checksum)
~
=/ checksum-pos (sub (lent data-and-checksum) 6)
`[hrp (scag checksum-pos data-and-checksum) (slag checksum-pos data-and-checksum)]
:: +from-address: BIP173 bech32 address encoding to hex
:: https://github.com/bitcoin/bips/blob/master/bip-0173.mediawiki
:: expects to drop a leading 5-bit 0 (the witness version)
::
++ from-address
|= body=cord
^- hexb
~| "Invalid bech32 address"
=/ d=(unit raw-decoded) (decode-raw body)
?> ?=(^ d)
=/ bs=bits (from-atoms:bit 5 data.u.d)
=/ byt-len=@ (div (sub wid.bs 5) 8)
?> =(5^0b0 (take:bit 5 bs))
?> ?| =(20 byt-len)
=(32 byt-len)
==
[byt-len `@ux`dat:(take:bit (mul 8 byt-len) (drop:bit 5 bs))]
:: pubkey is the 33 byte ECC compressed public key
::
++ encode-pubkey
|= [=network pubkey=byts]
^- (unit cord)
?. =(33 wid.pubkey)
~|('pubkey must be a 33 byte ECC compressed public key' !!)
=/ prefix (~(get by prefixes) network)
?~ prefix ~
:- ~
%+ encode-raw u.prefix
[0v0 (to-atoms:bit 5 [160 `@ub`dat:(hash-160 pubkey)])]
--

182
pkg/arvo/lib/bip/b174.hoon Normal file
View File

@ -0,0 +1,182 @@
:: BIP174: PSBTs
:: https://github.com/bitcoin/bips/blob/master/bip-0174.mediawiki
::
/- sur=bitcoin
/+ bcu=bitcoin-utils
=, sur
=, bcu
|%
++ en
|%
++ globals
|= rawtx=hexb
^- map:psbt
:~ [[1 0x0] rawtx]
==
::
++ input
|= [only-witness=? i=in:psbt]
^- map:psbt
%+ weld
?: only-witness ~
~[[1^0x0 rawtx.i]]
:~ (witness-tx i)
(hdkey %input hdkey.i)
==
::
++ output
|= =out:psbt
^- map:psbt
?~ hk.out ~
:~ (hdkey %output u.hk.out)
==
::
++ witness-tx
|= i=in:psbt
^- keyval:psbt
:- [1 0x1]
%- cat:byt
:~ (flip:byt 8^value.utxo.i)
1^0x16
2^0x14
(hash-160 pubkey.hdkey.i)
==
::
++ hdkey
|= [=target:psbt h=^hdkey]
^- keyval:psbt
=/ typ=@ux
?- target
%input 0x6
%output 0x2
==
=/ coin-type=hexb
?- network.h
%main
1^0x0
%testnet
1^0x1
==
:- (cat:byt ~[1^typ pubkey.h])
%- cat:byt
:~ fprint.h
1^`@ux`bipt.h 3^0x80
coin-type 3^0x80
4^0x80
1^`@ux`chyg.h 3^0x0
(flip:byt 4^idx.h)
==
::
++ keyval-byts
|= kv=keyval:psbt
^- hexb
%- cat:byt
:~ 1^wid.key.kv
key.kv
1^wid.val.kv
val.kv
==
::
++ map-byts
|= m=map:psbt
^- (unit hexb)
?~ m ~
:- ~
%- cat:byt
(turn m keyval-byts)
--
++ base64
|= b=hexb
^- base64:psbt
%- en:base64:mimes:html
(flip:byt b)
:: +encode: make base64 cord of PSBT
:: - only-witness: don't include non-witness UTXO
::
++ encode
|= $: only-witness=?
rawtx=hexb
txid=hexb
inputs=(list in:psbt)
outputs=(list out:psbt)
==
^- base64:psbt
=/ sep=(unit hexb) `1^0x0
=/ final=(list (unit hexb))
%+ join sep
%+ turn
%- zing
:~ ~[(globals:en rawtx)]
(turn inputs (cury input:en only-witness))
(turn outputs output:en)
==
map-byts:en
%- base64:en
^- byts
%- cat:byt
%+ weld ~[[5 0x70.7362.74ff]]
(murn (snoc final sep) same)
::
++ parse
|= psbt-base64=cord
^- (list map:psbt)
=/ todo=hexb
(drop:byt 5 (to-byts psbt-base64))
=| acc=(list map:psbt)
=| m=map:psbt
|-
?: =(wid.todo 0)
(snoc acc m)
:: 0x0: map separator
::
?: =(1^0x0 (take:byt 1 todo))
$(acc (snoc acc m), m *map:psbt, todo (drop:byt 1 todo))
=^ kv todo (next-keyval todo)
$(m (snoc m kv))
:: +get-txid: extract txid from a valid PSBT
::
++ get-txid
|= psbt-base64=cord
^- hexb
=/ tx=hexb
%- raw-tx
%+ drop:byt 5
(to-byts psbt-base64)
%- flip:byt
(dsha256 tx)
:: +raw-tx: extract hex transaction
:: looks for key 0x0 in global map
:: crashes if tx not in hex
::
++ raw-tx
|= b=hexb
^- hexb
|-
?: =(wid.b 0) !!
?: =(1^0x0 (take:byt 1 b)) !!
=/ nk (next-keyval b)
?: =(0x0 dat.key.kv.nk)
val.kv.nk
$(b rest.nk)
:: +next-keyval: returns next key-val in a PSBT map
:: input first byte must be a map key length
::
++ next-keyval
|= b=hexb
^- [kv=keyval:psbt rest=hexb]
=/ klen dat:(take:byt 1 b)
=/ k (take:byt klen (drop:byt 1 b))
=/ vlen dat:(take:byt 1 (drop:byt (add 1 klen) b))
=/ v (take:byt vlen (drop:byt (add 2 klen) b))
?> ?&((gth wid.k 0) (gth wid.v 0))
:- [k v]
(drop:byt ;:(add 2 klen vlen) b)
::
++ to-byts
|= psbt-base64=cord
^- hexb
~| "Invalid PSBT"
=+ p=(de:base64:mimes:html psbt-base64)
?~ p !!
(flip:byt u.p)
--

234
pkg/arvo/lib/bitcoin-json.hoon Normal file
View File

@ -0,0 +1,234 @@
/- btc-wallet, btc-provider, bitcoin
/+ bl=bitcoin
|%
++ dejs
=, dejs:format
|%
++ command
|= jon=json
^- command:btc-wallet
%. jon
%- of
:~ set-provider+(mu ship)
check-provider+ship
check-payee+ship
set-current-wallet+so
add-wallet+add-wallet
delete-wallet+so
init-payment-external+init-payment-external
init-payment+init-payment
broadcast-tx+so
gen-new-address+|=(json ~)
==
::
++ ship (su ;~(pfix sig fed:ag))
::
++ add-wallet
%- ot
:~ xpub+so
fprint+(at [ni ni ~])
scan-to+(mu (at [ni ni ~]))
max-gap+(mu ni)
confs+(mu ni)
==
::
++ init-payment-external
%- ot
:~ address+address
value+ni
feyb+ni
note+(mu so)
==
::
++ init-payment
%- ot
:~ payee+ship
value+ni
feyb+ni
note+(mu so)
==
::
++ address
|= jon=json
?> ?=([%s @t] jon)
^- address:bitcoin
(from-cord:adr:bl +.jon)
--
::
++ enjs
=, enjs:format
|%
++ status
|= sta=status:btc-provider
^- json
%+ frond -.sta
?- -.sta
%connected (connected sta)
%new-block (new-block sta)
%disconnected ~
==
::
++ connected
|= sta=status:btc-provider
?> ?=(%connected -.sta)
%- pairs
:~ network+s+network.sta
block+(numb block.sta)
fee+?~(fee.sta ~ (numb u.fee.sta))
==
::
++ new-block
|= sta=status:btc-provider
?> ?=(%new-block -.sta)
%- pairs
:~ network+s+network.sta
block+(numb block.sta)
fee+?~(fee.sta ~ (numb u.fee.sta))
blockhash+(hexb blockhash.sta)
blockfilter+(hexb blockfilter.sta)
==
::
++ hexb
|= h=hexb:bitcoin
^- json
%- pairs
:~ wid+(numb:enjs wid.h)
dat+s+(scot %ux dat.h)
==
::
++ update
|= upd=update:btc-wallet
^- json
%+ frond -.upd
?- -.upd
%initial (initial upd)
%change-provider (change-provider upd)
%change-wallet (change-wallet upd)
%psbt (psbt upd)
%btc-state (btc-state btc-state.upd)
%new-tx (hest hest.upd)
%cancel-tx (hexb txid.upd)
%new-address (address address.upd)
%balance (balance balance.upd)
%error s+error.upd
%broadcast-success ~
==
::
++ initial
|= upd=update:btc-wallet
?> ?=(%initial -.upd)
^- json
%- pairs
:~ provider+(provider provider.upd)
wallet+?~(wallet.upd ~ [%s u.wallet.upd])
balance+(balance balance.upd)
history+(history history.upd)
btc-state+(btc-state btc-state.upd)
address+?~(address.upd ~ (address u.address.upd))
==
::
++ change-provider
|= upd=update:btc-wallet
?> ?=(%change-provider -.upd)
^- json
(provider provider.upd)
::
++ change-wallet
|= upd=update:btc-wallet
?> ?=(%change-wallet -.upd)
^- json
%- pairs
:~ wallet+?~(wallet.upd ~ [%s u.wallet.upd])
balance+(balance balance.upd)
history+(history history.upd)
==
::
++ psbt
|= upd=update:btc-wallet
?> ?=(%psbt -.upd)
^- json
%- pairs
:~ pb+s+pb.upd
fee+(numb fee.upd)
==
::
++ balance
|= b=(unit [p=@ q=@])
^- json
?~ b ~
%- pairs
:~ confirmed+(numb p.u.b)
unconfirmed+(numb q.u.b)
==
::
++ btc-state
|= bs=btc-state:btc-wallet
^- json
%- pairs
:~ block+(numb block.bs)
fee+?~(fee.bs ~ (numb u.fee.bs))
date+(sect t.bs)
==
::
++ provider
|= p=(unit provider:btc-wallet)
^- json
?~ p ~
%- pairs
:~ host+(ship host.u.p)
connected+b+connected.u.p
==
::
++ history
|= hy=history:btc-wallet
^- json
:- %o
^- (map @t json)
%- ~(rep by hy)
|= [[=txid:btc-wallet h=hest:btc-wallet] out=(map @t json)]
^- (map @t json)
(~(put by out) (scot %ux dat.txid) (hest h))
::
++ hest
|= h=hest:btc-wallet
^- json
%- pairs
:~ xpub+s+xpub.h
txid+(hexb txid.h)
confs+(numb confs.h)
recvd+?~(recvd.h ~ (sect u.recvd.h))
inputs+(vals inputs.h)
outputs+(vals outputs.h)
note+?~(note.h ~ [%s u.note.h])
==
::
++ vals
|= vl=(list [=val:tx:bitcoin s=(unit @p)])
^- json
:- %a
%+ turn vl
|= [v=val:tx:bitcoin s=(unit @p)]
%- pairs
:~ val+(val v)
ship+?~(s ~ (ship u.s))
==
::
++ val
|= v=val:tx:bitcoin
^- json
%- pairs
:~ txid+(hexb txid.v)
pos+(numb pos.v)
address+(address address.v)
value+(numb value.v)
==
::
++ address
|= a=address:bitcoin
^- json
?- -.a
%base58 [%s (rsh [3 2] (scot %uc +.a))]
%bech32 [%s +.a]
==
--
--

166
pkg/arvo/lib/bitcoin-utils.hoon Normal file
View File

@ -0,0 +1,166 @@
:: lib/bitcoin-utils.hoon
:: Utilities for working with BTC data types and transactions
::
/- sur=bitcoin
=, sur
|%
::
:: TODO: move this bit/byt stuff to zuse
:: bit/byte utilities
::
::
:: +blop: munge bit and byt sequences (cat, flip, take, drop)
::
++ blop
|_ =bloq
+$ biyts [wid=@ud dat=@]
++ cat
|= bs=(list biyts)
^- biyts
:- (roll (turn bs |=(b=biyts -.b)) add)
(can bloq (flop bs))
:: +flip: flip endianness while preserving lead/trail zeroes
::
++ flip
|= b=biyts
^- biyts
[wid.b (rev bloq b)]
:: +take: take n bloqs from front
:: pads front with extra zeroes if n is longer than input
::
++ take
|= [n=@ b=biyts]
^- biyts
?: (gth n wid.b)
[n dat.b]
[n (rsh [bloq (sub wid.b n)] dat.b)]
:: +drop: drop n bloqs from front
:: returns 0^0 if n >= width
::
++ drop
|= [n=@ b=biyts]
^- biyts
?: (gte n wid.b)
0^0x0
=+ n-take=(sub wid.b n)
[n-take (end [bloq n-take] dat.b)]
--
++ byt ~(. blop 3)
::
++ bit
=/ bl ~(. blop 0)
|%
++ cat cat:bl:bit
++ flip flip:bl:bit
++ take take:bl:bit
++ drop drop:bl:bit
++ from-atoms
|= [bitwidth=@ digits=(list @)]
^- bits
%- cat:bit
%+ turn digits
|= a=@
?> (lte (met 0 a) bitwidth)
[bitwidth `@ub`a]
:: +to-atoms: convert bits to atoms of bitwidth
::
++ to-atoms
|= [bitwidth=@ bs=bits]
^- (list @)
=| res=(list @)
?> =(0 (mod wid.bs bitwidth))
|-
?: =(0 wid.bs) res
%= $
res (snoc res dat:(take:bit bitwidth bs))
bs (drop:bit bitwidth bs)
==
--
:: big endian sha256: input and output are both MSB first (big endian)
::
++ sha256
|= =byts
^- hexb
%- flip:byt
[32 (shay (flip:byt byts))]
::
++ dsha256
|= =byts
(sha256 (sha256 byts))
::
++ hash-160
|= val=byts
^- hexb
=, ripemd:crypto
:- 20
%- ripemd-160
(sha256 val)
::
:: hxb: hex parsing utilities
::
++ hxb
|%
++ from-cord
|= h=@t
^- hexb
?: =('' h) 1^0x0
:: Add leading 00
::
=+ (lsh [3 2] h)
:: Group by 4-size block
::
=+ (rsh [3 2] -)
:: Parse hex to atom
::
:- (div (lent (trip h)) 2)
`@ux`(rash - hex)
::
++ to-cord
|= =hexb
^- cord
(en:base16:mimes:html hexb)
--
::
:: +csiz: CompactSize integers (a Bitcoin-specific datatype)
:: https://btcinformation.org/en/developer-reference#compactsize-unsigned-integers
:: - encode: big endian to little endian
:: - decode: little endian to big endian
::
++ csiz
|%
++ en
|= a=@
^- hexb
=/ l=@ (met 3 a)
?: =(l 1) 1^a
?: =(l 2) (cat:byt ~[1^0xfd (flip:byt 2^a)])
?: (lte l 4) (cat:byt ~[1^0xfe (flip:byt 4^a)])
?: (lte l 8) (cat:byt ~[1^0xff (flip:byt 8^a)])
~|("Cannot encode CompactSize longer than 8 bytes" !!)
::
++ de
|= h=hexb
^- [n=hexb rest=hexb]
=/ s=@ux dat:(take:byt 1 h)
?: (lth s 0xfd) [1^s (drop:byt 1 h)]
~| "Invalid compact-size at start of {<h>}"
=/ len=bloq
?+ s !!
%0xfd 1
%0xfe 2
%0xff 3
==
:_ (drop:byt (add 1 len) h)
%- flip:byt
(take:byt (bex len) (drop:byt 1 h))
:: +dea: atom instead of hexb for parsed CompactSize
::
++ dea
|= h=hexb
^- [a=@ rest=hexb]
=> (de h)
[dat.n rest]
--
::
--

286
pkg/arvo/lib/bitcoin.hoon Normal file
View File

@ -0,0 +1,286 @@
:: bitcoin.hoon
:: top-level Bitcoin constants
:: expose BIP libraries
::
/- sur=bitcoin
/+ bech32=bip-b173, pbt=bip-b174, bcu=bitcoin-utils, bip-b158
=, sur
=, bcu
|%
++ overhead-weight ^-(vbytes 11)
++ input-weight
|= =bipt
^- vbytes
?- bipt
%44 148
%49 91
%84 68
==
++ output-weight
|= =bipt
^- vbytes
?- bipt
%44 34
%49 32
%84 31
==
::
++ xpub-type
|= =xpub
^- [=bipt =network]
=/ prefix=tape (scag 4 (trip xpub))
?: =("tpub" prefix) [%44 %testnet]
?: =("upub" prefix) [%49 %testnet]
?: =("vpub" prefix) [%84 %testnet]
?: =("xpub" prefix) [%44 %main]
?: =("ypub" prefix) [%49 %main]
?: =("zpub" prefix) [%84 %main]
~|("invalid xpub: {<xpub>}" !!)
::
:: adr: address manipulation
::
++ adr
|%
++ get-bipt
|= a=address
^- bipt
=/ spk=hexb (to-script-pubkey:adr a)
?: =(25 wid.spk) %44
?: =(23 wid.spk) %49
?: =(22 wid.spk) %84
?: =(34 wid.spk) %84
~|("Invalid address" !!)
::
++ to-cord
|= a=address ^- cord
?: ?=([%base58 *] a)
(scot %uc +.a)
+.a
::
++ from-pubkey
|= [=bipt =network pubkey=hexb]
^- address
?- bipt
%44
:- %base58
=< ^-(@uc dat)
%- cat:byt
:- ?- network
%main 1^0x0
%testnet 1^0x6f
==
~[(hash-160 pubkey)]
::
%49
:- %base58
=< ^-(@uc dat)
%- cat:byt
:~ ?- network
%main 1^0x5
%testnet 1^0xc4
==
%- hash-160
(cat:byt ~[2^0x14 (hash-160 pubkey)])
==
::
%84
:- %bech32
(need (encode-pubkey:bech32 network pubkey))
==
::
++ from-cord
|= addrc=@t
|^
=/ addrt=tape (trip addrc)
^- address
?: (is-base58 addrt)
[%base58 `@uc`(scan addrt fim:ag)]
?: (is-bech32 addrt)
[%bech32 addrc]
~|("Invalid address: {<addrc>}" !!)
::
++ is-base58
|= at=tape
^- ?
?| =("m" (scag 1 at))
=("1" (scag 1 at))
=("3" (scag 1 at))
=("2" (scag 1 at))
==
::
++ is-bech32
|= at=tape
^- ?
?| =("bc1" (scag 3 at))
=("tb1" (scag 3 at))
==
--
::
++ to-script-pubkey
|= =address
^- hexb
?- -.address
%bech32
=+ h=(from-address:bech32 +.address)
%- cat:byt
:~ 1^0x0
1^wid.h
h
==
::
%base58
=/ h=hexb [21 `@ux`+.address]
=+ lead-byt=dat:(take:byt 1 h)
=/ version-network=[bipt network]
?: =(0x0 lead-byt) [%44 %main]
?: =(0x6f lead-byt) [%44 %testnet]
?: =(0x5 lead-byt) [%49 %main]
?: =(0xc4 lead-byt) [%49 %testnet]
~|("Invalid base58 address: {<+.address>}" !!)
%- cat:byt
?: ?=(%44 -.version-network)
:~ 3^0x76.a914
(drop:byt 1 h)
2^0x88ac
==
:~ 2^0xa914
(drop:byt 1 h)
1^0x87
==
==
--
::
:: +txu: transaction utility core
:: - primarily used for calculating txids
:: - ignores signatures in inputs
::
++ txu
|%
++ en
|%
++ input
|= i=input:tx
^- hexb
%- cat:byt
:~ (flip:byt txid.i)
(flip:byt 4^pos.i)
?~ script-sig.i 1^0x0
%- cat:byt
~[(en:csiz wid.u.script-sig.i) u.script-sig.i]
(flip:byt sequence.i)
==
::
++ output
|= o=output:tx
^- hexb
%- cat:byt
:~ (flip:byt 8^value.o)
1^wid.script-pubkey.o
script-pubkey.o
==
--
::
++ de
|%
++ nversion
|= b=hexb
^- [nversion=@ud rest=hexb]
:- dat:(flip:byt (take:byt 4 b))
(drop:byt 4 b)
::
++ segwit
|= b=hexb
^- [segwit=(unit @ud) rest=hexb]
?. =(1^0x0 (take:byt 1 b))
[~ b]
:- [~ dat:(take:byt 2 b)]
(drop:byt 2 b)
::
++ script-sig
|= b=hexb
^- [sig=hexb rest=hexb]
=^ siglen=hexb b (de:csiz b)
:- (take:byt dat.siglen b)
(drop:byt dat.siglen b)
::
++ sequence
|= b=hexb
^- [seq=hexb rest=hexb]
[(flip:byt (take:byt 4 b)) (drop:byt 4 b)]
::
++ inputs
|= b=hexb
^- [is=(list input:tx) rest=hexb]
|^
=| acc=(list input:tx)
=^ count b (dea:csiz b)
|-
?: =(0 count) [acc b]
=^ i b (input b)
$(acc (snoc acc i), count (dec count))
::
++ input
|= b=hexb
^- [i=input:tx rest=hexb]
=/ txid (flip:byt (take:byt 32 b))
=/ pos dat:(flip:byt (take:byt 4 (drop:byt 32 b)))
=^ sig=hexb b (script-sig (drop:byt 36 b))
=^ seq=hexb b (sequence b)
:_ b
[txid pos seq ?:((gth wid.sig 0) `sig ~) ~ 0]
--
::
++ outputs
|= b=hexb
^- [os=(list output:tx) rest=hexb]
=| acc=(list output:tx)
=^ count b (dea:csiz b)
|-
?: =(0 count) [acc b]
=/ value (flip:byt (take:byt 8 b))
=^ scriptlen b (dea:csiz (drop:byt 8 b))
%= $
acc %+ snoc acc
:- (take:byt scriptlen b)
dat.value
b (drop:byt scriptlen b)
count (dec count)
==
--
:: +basic-encode: encodes data in a format suitable for hashing
::
++ basic-encode
|= =data:tx
^- hexb
%- cat:byt
%- zing
:~ ~[(flip:byt 4^nversion.data)]
~[(en:csiz (lent is.data))]
(turn is.data input:en)
~[(en:csiz (lent os.data))]
(turn os.data output:en)
~[(flip:byt 4^locktime.data)]
==
++ get-id
|= =data:tx
^- hexb
%- flip:byt
%- dsha256
(basic-encode data)
::
++ decode
|= b=hexb
^- data:tx
=^ nversion b
(nversion:de b)
=^ segwit b
(segwit:de b)
=^ inputs b
(inputs:de b)
=^ outputs b
(outputs:de b)
=/ locktime=@ud
dat:(take:byt 4 (flip:byt b))
[inputs outputs locktime nversion segwit]
--
--

209
pkg/arvo/lib/btc-provider.hoon Normal file
View File

@ -0,0 +1,209 @@
/- bp=btc-provider, json-rpc
/+ bc=bitcoin
^?
::=< [sur .]
::=, sur
|%
:: +from-epoch: time since Jan 1, 1970 in seconds.
::
++ from-epoch
|= secs=@ud
^- (unit @da)
?: =(0 secs) ~
[~ (add ~1970.1.1 `@dr`(mul secs ~s1))]
::
++ get-request
|= url=@t
^- request:http
[%'GET' url ~ ~]
::
++ post-request
|= [url=@t body=json]
^- request:http
:* %'POST'
url
~[['Content-Type' 'application/json']]
=, html
%- some
%- as-octt:mimes
(en-json body)
==
::
++ gen-request
|= [=host-info:bp ract=action:rpc-types:bp]
^- request:http
%+ rpc-action-to-http
api-url.host-info ract
::
++ rpc
=, dejs:format
|%
++ parse-result
|= res=response:json-rpc
|^ ^- result:rpc-types:bp
~| -.res
?> ?=(%result -.res)
?+ id.res ~|([%unsupported-result id.res] !!)
%get-address-info
[id.res (address-info res.res)]
::
%get-tx-vals
[id.res (tx-vals res.res)]
::
%get-raw-tx
[id.res (raw-tx res.res)]
::
%broadcast-tx
[%broadcast-tx (broadcast-tx res.res)]
::
%get-block-count
[id.res (ni res.res)]
::
%get-block-info
[id.res (block-info res.res)]
==
++ address-info
%- ot
:~ [%address (cu from-cord:adr:bc so)]
[%utxos (as utxo)]
[%used bo]
[%block ni]
==
++ utxo
%- ot
:~ ['tx_pos' ni]
['tx_hash' (cu from-cord:hxb:bc so)]
[%height ni]
[%value ni]
[%recvd (cu from-epoch ni)]
==
++ tx-vals
%- ot
:~ [%included bo]
[%txid (cu from-cord:hxb:bc so)]
[%confs ni]
[%recvd (cu from-epoch ni)]
[%inputs (ar tx-val)]
[%outputs (ar tx-val)]
==
++ tx-val
%- ot
:~ [%txid (cu from-cord:hxb:bc so)]
[%pos ni]
[%address (cu from-cord:adr:bc so)]
[%value ni]
==
++ raw-tx
%- ot
:~ [%txid (cu from-cord:hxb:bc so)]
[%rawtx (cu from-cord:hxb:bc so)]
==
++ broadcast-tx
%- ot
:~ [%txid (cu from-cord:hxb:bc so)]
[%broadcast bo]
[%included bo]
==
++ block-info
%- ot
:~ [%block ni]
[%fee (mu ni)]
[%blockhash (cu from-cord:hxb:bc so)]
[%blockfilter (cu from-cord:hxb:bc so)]
==
--
--
::
++ rpc-action-to-http
|= [endpoint=@t ract=action:rpc-types:bp]
|^ ^- request:http
?- -.ract
%get-address-info
%- get-request
%+ mk-url '/addresses/info/'
(to-cord:adr:bc address.ract)
::
%get-tx-vals
%- get-request
%+ mk-url '/gettxvals/'
(to-cord:hxb:bc txid.ract)
::
%get-raw-tx
%- get-request
%+ mk-url '/getrawtx/'
(to-cord:hxb:bc txid.ract)
::
%broadcast-tx
%- get-request
%+ mk-url '/broadcasttx/'
(to-cord:hxb:bc rawtx.ract)
::
%get-block-count
%- get-request
(mk-url '/getblockcount' '')
::
%get-block-info
%- get-request
(mk-url '/getblockinfo' '')
==
++ mk-url
|= [base=@t params=@t]
%^ cat 3
(cat 3 endpoint base) params
--
:: RPC/HTTP Utilities
::
++ httr-to-rpc-response
|= hit=httr:eyre
^- response:json-rpc
~| hit
=/ jon=json (need (de-json:html q:(need r.hit)))
?. =(%2 (div p.hit 100))
(parse-rpc-error jon)
=, dejs-soft:format
^- response:json-rpc
=; dere
=+ res=((ar dere) jon)
?~ res (need (dere jon))
[%batch u.res]
|= jon=json
^- (unit response:json-rpc)
=/ res=[id=(unit @t) res=(unit json) err=(unit json)]
%. jon
=, dejs:format
=- (ou -)
:~ ['id' (uf ~ (mu so))]
['result' (uf ~ (mu same))]
['error' (uf ~ (mu same))]
==
?: ?=([^ * ~] res)
`[%result [u.id.res ?~(res.res ~ u.res.res)]]
~| jon
`(parse-rpc-error jon)
::
++ get-rpc-response
|= response=client-response:iris
^- response:json-rpc
?> ?=(%finished -.response)
%- httr-to-rpc-response
%+ to-httr:iris
response-header.response
full-file.response
::
++ parse-rpc-error
|= =json
^- response:json-rpc
:- %error
?~ json ['' '' '']
%. json
=, dejs:format
=- (ou -)
:~ =- ['id' (uf '' (cu - (mu so)))]
|*(a=(unit) ?~(a '' u.a))
:- 'error'
=- (uf ['' ''] -)
=- (cu |*(a=(unit) ?~(a ['' ''] u.a)) (mu (ou -)))
:~ ['code' (uf '' no)]
['message' (uf '' so)]
== ==
--

573
pkg/arvo/lib/btc.hoon Normal file
View File

@ -0,0 +1,573 @@
:: lib/btc.hoon
::
/- *btc-wallet, json-rpc, bp=btc-provider
/+ bip32, bc=bitcoin
=, secp:crypto
=+ ecc=secp256k1
|%
::
:: Formerly lib/btc-wallet.hoon
::
::
++ defaults
|%
++ max-gap 20
++ confs 6
--
:: +fam: planet parent if s is a moon
::
++ fam
|= [our=ship now=@da s=ship]
^- ship
?. =(%earl (clan:title s)) s
(sein:title our now s)
::
++ num-confs
|= [last-block=@ud =utxo:bc]
?: =(0 height.utxo) 0
(add 1 (sub last-block height.utxo))
::
++ from-xpub
|= $: =xpub:bc
=fprint:bc
scan-to=(unit scon)
max-gap=(unit @ud)
confs=(unit @ud)
==
^- walt
=/ [=bipt =network] (xpub-type:bc xpub)
:* xpub
network
fprint
+6:(from-extended:bip32 (trip xpub))
bipt
*wach
[0 0]
%.n
(fall scan-to *scon)
(fall max-gap max-gap:defaults)
(fall confs confs:defaults)
==
:: +address-coords: find wallet info for the address, if any
::
++ address-coords
|= [a=address ws=(list walt)]
^- (unit [w=walt =chyg =idx])
|^
|- ?~ ws ~
=/ res=(unit [=chyg =idx])
(lookup i.ws)
?^ res `[i.ws chyg.u.res idx.u.res]
$(ws t.ws)
::
++ lookup
|= w=walt
^- (unit [=chyg =idx])
=/ ad=(unit addi) (~(get by wach.w) a)
?~(ad ~ `[chyg.u.ad idx.u.ad])
--
::
++ new-txbu
|= $: w=walt
payee=(unit ship)
=vbytes:bc
is=(list insel)
txos=(list txo)
==
^- txbu
:* xpub.w
payee
vbytes
%+ turn is
|= i=insel
[utxo.i ~ (~(hdkey wad w chyg.i) idx.i)]
txos
~
==
:: txb: transaction builder helpers
::
++ txb
|_ t=txbu
++ value
^- [in=sats out=sats]
:- %+ roll
%+ turn txis.t
|=(=txi value.utxo.txi)
add
(roll (turn txos.t |=(=txo value.txo)) add)
::
++ fee
^- sats:bc
=/ [in=sats out=sats] value
(sub in out)
::
++ vbytes
^- vbytes:bc
%+ add overhead-weight:bc
%+ add
%+ roll
(turn txis.t |=(t=txi (input-weight:bc bipt.hdkey.t)))
add
%+ roll
(turn txos.t |=(t=txo (output-weight:bc (get-bipt:adr:bc address.t))))
add
++ tx-data
|^
^- data:tx:bc
:* (turn txis.t txi-data)
(turn txos.t txo-data)
0 1 `1
==
::
++ txi-data
|= =txi
:* txid.utxo.txi pos.utxo.txi
4^0xffff.ffff ~ ~ value.utxo.txi
==
++ txo-data
|= =txo
:- (to-script-pubkey:adr:bc address.txo)
value.txo
--
::
++ get-txid
^- txid
(get-id:txu:bc tx-data)
::
++ get-rawtx
(basic-encode:txu:bc tx-data)
:: +add-output: append output (usually change) to txos
::
++ add-output
|= =txo
^- txbu
:: todo update vbytes
t(txos (snoc [txos.t] txo))
:: +to-psbt: returns a based 64 PSBT if
:: - all inputs have an associated rawtx
::
++ to-psbt
^- (unit base64:psbt:bc)
=/ ins=(list in:psbt:bc)
%+ murn txis.t
|= =txi
?~ rawtx.txi ~
`[utxo.txi u.rawtx.txi hdkey.txi]
?: (lth (lent ins) (lent txis.t))
~
=/ outs=(list out:psbt:bc)
%+ turn txos.t
|=(=txo [address.txo hk.txo])
`(encode:pbt:bc %.y get-rawtx get-txid ins outs)
--
:: wad: door for processing walts (wallets)
:: parameterized on a walt and it's chyg account
::
++ wad
|_ [w=walt =chyg]
++ pubkey
|= =idx:bc
^- hexb:bc
=/ pk=@ux
%- compress-point:ecc
pub:(derive-public:(~(derive-public bip32 wamp.w) chyg) idx)
[(met 3 pk) pk]
::
++ hdkey
|= =idx:bc
^- hdkey:bc
[fprint.w (~(pubkey wad w chyg) idx) network.w bipt.w chyg idx]
::
++ mk-address
|= =idx:bc
^- address:bc
(from-pubkey:adr:bc bipt.w network.w (pubkey idx))
:: +nixt-address: used to get change addresses
:: - gets the current next available address
:: - doesn't bump nixt-address if it's unused
:: - if used, fall back to gen-address and make a new one
::
++ nixt-address
^- (trel address:bc idx:bc walt)
=/ addr (mk-address nixt-idx)
~| "lib/btc-wallet-store: get-next-address: nixt shouldn't be blank"
=/ =addi (~(got by wach.w) addr)
?. used.addi
[addr nixt-idx w]
gen-address
::
:: +gen-address:
:: - generates the next available address
:: - watches it (using update address)
::
++ gen-address
^- (trel address:bc idx:bc walt)
=/ addr (mk-address nixt-idx)
:* addr
nixt-idx
%+ update-address addr
[%.n chyg nixt-idx *(set utxo:bc)]
==
:: +update-address
:: - insert a new address
:: - if it's used, move "nixt" to the next free address
:: - watch address
::
++ update-address
|= [a=address:bc =addi]
^- walt
?> =(chyg chyg.addi)
?> =(a (mk-address idx.addi))
=? w ?&(used.addi (is-nixt addi))
bump-nixt
w(wach (~(put by wach.w) a addi))
::
++ is-nixt
|= =addi ^- ?
?: ?=(%0 chyg.addi)
=(idx.addi p.nixt.w)
=(idx.addi q.nixt.w)
++ nixt-idx
?:(?=(%0 chyg) p.nixt.w q.nixt.w)
:: +bump-nixt: return wallet with bumped nixt
:: - find next unused address
:: - watches that address
:: - crashes if max-index is passed
::
++ bump-nixt
|^ ^- walt
=/ new-idx=idx:bc +(nixt-idx)
|- ?> (lte new-idx max-index)
=+ addr=(mk-address new-idx)
=/ =addi
%+ ~(gut by wach.w) addr
[%.n chyg new-idx *(set utxo:bc)]
?. used.addi
%= w
nixt (set-nixt new-idx)
wach (~(put by wach.w) addr addi)
==
$(new-idx +(new-idx))
::
++ set-nixt
|= =idx:bc ^- nixt
?:(?=(%0 chyg) [idx q.nixt.w] [p.nixt.w idx])
--
--
:: sut: select utxos
::
++ sut
|_ [w=walt eny=@uvJ last-block=@ud payee=(unit ship) =feyb txos=(list txo)]
++ dust-sats 3
++ dust-threshold
|= output-bipt=bipt:bc
^- vbytes
(mul dust-sats (input-weight:bc output-bipt))
::
++ target-value
^- sats
%+ roll (turn txos |=(=txo value.txo))
|=([a=sats b=sats] (add a b))
::
++ base-weight
^- vbytes
%+ add overhead-weight:bc
%+ roll
%+ turn txos
|=(=txo (output-weight:bc (get-bipt:adr:bc address.txo)))
add
::
++ total-vbytes
|= selected=(list insel)
^- vbytes
%+ add base-weight
(mul (input-weight:bc bipt.w) (lent selected))
:: value of an input after fee
:: 0 if net is <= 0
::
++ net-value
|= val=sats
^- sats
=/ cost (mul (input-weight:bc bipt.w) feyb)
?: (lte val cost) 0
(sub val cost)
::
:: +spendable: whether utxo has enough confs to spend
::
++ spendable
|= =utxo:bc ^- ?
(gte (num-confs last-block utxo) confs.w)
:: +with-change:
:: - choose UTXOs, if there are enough
:: - return txbu and amount of change (if any)
::
++ with-change
^- [tb=(unit txbu) chng=(unit sats)]
=/ tb=(unit txbu) select-utxos
?~ tb [~ ~]
=+ excess=~(fee txb u.tb) :: (inputs - outputs)
=/ new-fee=sats :: cost of this tx + one more output
(mul feyb (add (output-weight:bc bipt.w) vbytes.u.tb))
?. (gth excess new-fee)
[tb ~]
?. (gth (sub excess new-fee) (dust-threshold bipt.w))
[tb ~]
:- tb
`(sub excess new-fee)
:: Uses naive random selection. Should switch to branch-and-bound later.
::
++ select-utxos
|^ ^- (unit txbu)
?. %+ levy txos
|= =txo
%+ gth value.txo
(dust-threshold (get-bipt:adr:bc address.txo))
~|("One or more suggested outputs is dust." !!)
=/ is=(unit (list insel))
%- single-random-draw
%- zing
(turn ~(val by wach.w) to-insels)
?~ is ~
`(new-txbu w payee (total-vbytes u.is) u.is txos)
::
++ to-insels
|= =addi
^- (list insel)
%+ turn ~(tap in utxos.addi)
|=(=utxo:bc [utxo chyg.addi idx.addi])
--
:: single-random-draw
:: randomly choose utxos until target is hit
:: only use an insel if its net-value > 0
::
++ single-random-draw
|= is=(list insel)
^- (unit (list insel))
=/ rng ~(. og eny)
=/ target (add target-value (mul feyb base-weight)) :: add base fees to target
=| [select=(list insel) total=sats:bc]
|-
?: =(~ is) ~
=^ n rng (rads:rng (lent is))
=/ i=insel (snag n is)
?. (spendable utxo.i)
$(is (oust [n 1] is))
=/ net-val (net-value value.utxo.i)
=? select (gth net-val 0)
[i select]
=/ new-total (add total net-val)
?: (gte new-total target) `select
%= $
is (oust [n 1] is)
total new-total
==
::
--
::
::
:: Formerly lib/btc-provider
::
::
++ from-epoch
|= secs=@ud
^- (unit @da)
?: =(0 secs) ~
[~ (add ~1970.1.1 `@dr`(mul secs ~s1))]
::
++ get-request
|= url=@t
^- request:http
[%'GET' url ~ ~]
::
++ post-request
|= [url=@t body=json]
^- request:http
:* %'POST'
url
~[['Content-Type' 'application/json']]
=, html
%- some
%- as-octt:mimes
(en-json body)
==
::
++ gen-request
|= [=host-info:bp ract=action:rpc-types:bp]
^- request:http
%+ rpc-action-to-http
api-url.host-info ract
::
++ rpc
=, dejs:format
|%
++ parse-result
|= res=response:json-rpc
|^ ^- result:rpc-types:bp
~| -.res
?> ?=(%result -.res)
?+ id.res ~|([%unsupported-result id.res] !!)
%get-address-info
[id.res (address-info res.res)]
::
%get-tx-vals
[id.res (tx-vals res.res)]
::
%get-raw-tx
[id.res (raw-tx res.res)]
::
%broadcast-tx
[%broadcast-tx (broadcast-tx res.res)]
::
%get-block-count
[id.res (ni res.res)]
::
%get-block-info
[id.res (block-info res.res)]
==
++ address-info
%- ot
:~ [%address (cu from-cord:adr:bc so)]
[%utxos (as utxo)]
[%used bo]
[%block ni]
==
++ utxo
%- ot
:~ ['tx_pos' ni]
['tx_hash' (cu from-cord:hxb:bc so)]
[%height ni]
[%value ni]
[%recvd (cu from-epoch ni)]
==
++ tx-vals
%- ot
:~ [%included bo]
[%txid (cu from-cord:hxb:bc so)]
[%confs ni]
[%recvd (cu from-epoch ni)]
[%inputs (ar tx-val)]
[%outputs (ar tx-val)]
==
++ tx-val
%- ot
:~ [%txid (cu from-cord:hxb:bc so)]
[%pos ni]
[%address (cu from-cord:adr:bc so)]
[%value ni]
==
++ raw-tx
%- ot
:~ [%txid (cu from-cord:hxb:bc so)]
[%rawtx (cu from-cord:hxb:bc so)]
==
++ broadcast-tx
%- ot
:~ [%txid (cu from-cord:hxb:bc so)]
[%broadcast bo]
[%included bo]
==
++ block-info
%- ot
:~ [%block ni]
[%fee (mu ni)]
[%blockhash (cu from-cord:hxb:bc so)]
[%blockfilter (cu from-cord:hxb:bc so)]
==
--
--
::
++ rpc-action-to-http
|= [endpoint=@t ract=action:rpc-types:bp]
|^ ^- request:http
?- -.ract
%get-address-info
%- get-request
%+ mk-url '/addresses/info/'
(to-cord:adr:bc address.ract)
::
%get-tx-vals
%- get-request
%+ mk-url '/gettxvals/'
(to-cord:hxb:bc txid.ract)
::
%get-raw-tx
%- get-request
%+ mk-url '/getrawtx/'
(to-cord:hxb:bc txid.ract)
::
%broadcast-tx
%- get-request
%+ mk-url '/broadcasttx/'
(to-cord:hxb:bc rawtx.ract)
::
%get-block-count
%- get-request
(mk-url '/getblockcount' '')
::
%get-block-info
=/ param=@t
?~(block.ract '' (rsh [3 2] (scot %ui u.block.ract)))
%- get-request
(mk-url '/getblockinfo/' param)
==
++ mk-url
|= [base=@t params=@t]
%^ cat 3
(cat 3 endpoint base) params
--
:: RPC/HTTP Utilities
::
++ httr-to-rpc-response
|= hit=httr:eyre
^- response:json-rpc
~| hit
=/ jon=json (need (de-json:html q:(need r.hit)))
?. =(%2 (div p.hit 100))
(parse-rpc-error jon)
=, dejs-soft:format
^- response:json-rpc
=; dere
=+ res=((ar dere) jon)
?~ res (need (dere jon))
[%batch u.res]
|= jon=json
^- (unit response:json-rpc)
=/ res=[id=(unit @t) res=(unit json) err=(unit json)]
%. jon
=, dejs:format
=- (ou -)
:~ ['id' (uf ~ (mu so))]
['result' (uf ~ (mu same))]
['error' (uf ~ (mu same))]
==
?: ?=([^ * ~] res)
`[%result [u.id.res ?~(res.res ~ u.res.res)]]
~| jon
`(parse-rpc-error jon)
::
++ get-rpc-response
|= response=client-response:iris
^- response:json-rpc
?> ?=(%finished -.response)
%- httr-to-rpc-response
%+ to-httr:iris
response-header.response
full-file.response
::
++ parse-rpc-error
|= =json
^- response:json-rpc
:- %error
?~ json ['' '' '']
%. json
=, dejs:format
=- (ou -)
:~ =- ['id' (uf '' (cu - (mu so)))]
|*(a=(unit) ?~(a '' u.a))
:- 'error'
=- (uf ['' ''] -)
=- (cu |*(a=(unit) ?~(a ['' ''] u.a)) (mu (ou -)))
:~ ['code' (uf '' no)]
['message' (uf '' so)]
== ==
--

2
pkg/arvo/lib/contact.hoon
View File

@ -42,6 +42,7 @@
(snoc rids [our.bowl %''])
--
++ scry-sharing
^- (set resource)
.^ (set resource)
%gx
(scot %p our.bowl)
@ -58,6 +59,7 @@
(~(get by rolodex) ship)
::
++ scry-is-public
^- ?
.^ ?
%gx
(scot %p our.bowl)

36
pkg/arvo/lib/dm-hook.hoon Normal file
View File

@ -0,0 +1,36 @@
/- *dm-hook
|%
::
++ dejs
=, dejs:format
|%
++ action
|^
%- of
:~ accept+ship
decline+ship
pendings+ships
screen+bo
==
::
++ ship (su ;~(pfix sig fed:ag))
::
++ ships (as ship)
--
--
::
++ enjs
=, enjs:format
|%
::
++ action
|= act=^action
%+ frond -.act
?- -.act
?(%accept %decline) (ship +.act)
%pendings a+(turn ~(tap in ships.act) ship)
%screen [%b +.act]
==
--
--

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

@ -28,8 +28,8 @@
rose+(ot style+(ot mid+sa open+sa close+sa ~) lines+(ar dank) ~)
==
::
++ orm ((ordered-map atom node) gth)
++ orm-log ((ordered-map time logged-update) gth)
++ orm ((on atom node) gth)
++ orm-log ((on time logged-update) gth)
::
++ enjs
=, enjs:format
@ -311,7 +311,7 @@
++ graph
|= a=json
^- ^graph
=/ or-mp ((ordered-map atom ^node) gth)
=/ or-mp ((on atom ^node) gth)
%+ gas:or-mp ~
%+ turn ~(tap by ((om node) a))
|* [b=cord c=*]
@ -559,7 +559,7 @@
=>
|%
++ in-orm
((ordered-map atom in-node) gth)
((on atom in-node) gth)
+$ in-node
[post=in-pst children=in-internal-graph]
+$ in-graph
@ -571,7 +571,7 @@
==
::
++ out-orm
((ordered-map atom out-node) gth)
((on atom out-node) gth)
+$ out-node
[post=out-pst children=out-internal-graph]
+$ out-graph
@ -823,7 +823,7 @@
++ remake-update-log
|= t=tree-update-log
^- update-log
=/ ulm ((ordered-map time logged-update) gth)
=/ ulm ((on time logged-update) gth)
%+ gas:ulm *update-log
%+ turn ~(tap by t)
|= [=time tlu=tree-logged-update]

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

@ -1,6 +1,14 @@
/- *resource
/+ store=graph-store
|_ =bowl:gall
++ cg
|%
++ update
|= =update:store
^- cage
[%graph-update-2 !>(update)]
--
::
++ scry-for
|* [=mold =path]
.^ mold

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

@ -34,10 +34,12 @@
::
++ scry-group
|= rid=resource
^- (unit group)
%+ scry-for ,(unit group)
`path`groups+(en-path:resource rid)
::
++ scry-groups
^- (set resource)
.^ ,(set resource)
%gy
(scot %p our.bowl)
@ -48,6 +50,7 @@
::
++ members
|= rid=resource
^- (set ship)
=; =group
members.group
(fall (scry-group rid) *group)
@ -101,6 +104,7 @@
::
++ can-join
|= [rid=resource =ship]
^- ?
%+ scry-for ,?
^- path
:- %groups
@ -121,6 +125,7 @@
::
++ is-managed
|= rid=resource
^- ?
=/ group=(unit group)
(scry-group rid)
?~ group %.n

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

@ -4,6 +4,247 @@
=< [. sur]
=, sur
|%
++ upgrade
|%
++ to-three
=* two state-two
=* three state-three
|%
++ index
|= =index:two
^- (unit index:three)
`index
++ contents
|= =contents:two
^- (unit contents:three)
?. ?=(%group -.contents)
`contents
=- ?: =(~ -) ~
`[%group -]
%+ murn list.contents
|= =group-contents:two
^- (unit group-contents:three)
?: ?=(?(%add %remove) -.group-contents)
~
`group-contents
::
++ stats-index
|= =stats-index:two
^- (unit stats-index:three)
`stats-index
::
++ notifications
upg-notifications:upg
::
++ upg
%. [index stats-index contents]
%: upgrade
index:two
stats-index:two
contents:two
index:three
stats-index:three
contents:three
==
--
::
++ to-four
=* three state-three
=* four state-four
|%
++ index
|= =index:three
^- (unit index:four)
`index
++ contents
|= =contents:three
^- (unit contents:four)
?. ?=(%graph -.contents)
`contents
`[%graph (turn list.contents post-to-one:upgrade:graph-store)]
::
++ unreads-each
upg-unreads-each:upg
::
++ notifications
upg-notifications:upg
::
++ stats-index
|= =stats-index:three
^- (unit stats-index:four)
`stats-index
::
++ upg
%. [index stats-index contents]
%: upgrade
index:three
stats-index:three
contents:three
index:four
stats-index:four
contents:four
==
--
::
++ to-five
=* four state-four
=* five sur
|%
++ mark
|= module=@t
^- (unit @t)
?+ module ~
%chat `%graph-validator-chat
%publish `%graph-validator-publish
%link `%graph-validator-link
==
++ index
|= =index:four
^- (unit index:five)
?: ?=(%group -.index)
`index
=* i index
`[%graph graph.i (mark module.i) description.i index.i]
::
++ contents
|= =contents:four
^- (unit contents:five)
`contents
::
++ unreads-each
upg-unreads-each:upg
::
++ stats-index
|= =stats-index:four
^- (unit stats-index:five)
`stats-index
::
++ upg
%. [index stats-index contents]
%: upgrade
index:four
stats-index:four
contents:four
index:five
stats-index:five
contents:five
==
++ notifications
upg-notifications:upg
--
::
++ upgrade
|* $: :: input molds
in-index=mold
in-stats-index=mold
in-contents=mold
:: output molds
out-index=mold
out-stats-index=mold
out-contents=mold
==
=> . =>
|%
::
++ in
|%
::
+$ index in-index
+$ stats-index in-stats-index
+$ contents in-contents
+$ unreads-each (jug stats-index index)
+$ timebox (map index notification)
+$ notification
[date=@da read=? =contents]
++ orm
((ordered-map time timebox) gth)
+$ notifications
((mop time timebox) gth)
--
++ out
|%
::
::
+$ index out-index
+$ stats-index out-stats-index
+$ contents out-contents
+$ timebox (map out-index notification)
+$ unreads-each (jug stats-index index)
+$ notification
[date=@da read=? contents=out-contents]
+$ notifications
((mop time timebox) gth)
++ orm
((ordered-map time timebox) gth)
--
--
|= $: fun-index=$-(index:in (unit index:out))
fun-stats-index=$-(stats-index:in (unit stats-index:out))
fun-contents=$-(contents:in (unit contents:out))
==
|%
::
++ upg-unreads-each
|= =unreads-each:in
^- unreads-each:out
%- ~(gas by *unreads-each:out)
%+ murn ~(tap by unreads-each)
|= [=stats-index:in indices=(set index:in)]
^- (unit [stats-index:out (set index:out)])
=/ new-stats
(fun-stats-index stats-index)
?~ new-stats ~
=/ new-indices
(upg-indices indices)
?: =(0 ~(wyt ^in new-indices)) ~
`[u.new-stats new-indices]
::
++ upg-indices
|= indices=(set index:in)
^- (set index:out)
%- ~(gas ^in *(set index:out))
(murn ~(tap ^in indices) fun-index)
::
++ upg-notifications
|= =notifications:in
^- notifications:out
%+ gas:orm:out *notifications:out
^- (list [@da timebox:out])
%+ murn (tap:orm:in notifications)
|= [time=@da =timebox:in]
^- (unit [@da =timebox:out])
=/ new-timebox=timebox:out
(upg-timebox timebox)
?: =(0 ~(wyt by timebox))
~
`[time new-timebox]
::
++ upg-timebox
|= =timebox:in
^- timebox:out
%- ~(gas by *timebox:out)
%+ murn ~(tap by timebox)
|= [=index:in =notification:in]
^- (unit [index:out notification:out])
=/ new-index
(fun-index index)
?~ new-index ~
=/ new-notification
(upg-notification notification)
?~ new-notification ~
`[u.new-index u.new-notification]
::
++ upg-notification
|= n=notification:in
^- (unit notification:out)
=/ new-contents
(fun-contents contents.n)
?~ new-contents ~
`[date.n read.n u.new-contents]
--
--
++ dejs
=, dejs:format
|%
@ -21,9 +262,8 @@
::
++ graph-index
%- ot
:~ group+dejs-path:resource
graph+dejs-path:resource
module+so
:~ graph+dejs-path:resource
mark+(mu so)
description+so
index+(su ;~(pfix fas (more fas dem)))
==
@ -47,9 +287,9 @@
`@da`(rash p.jon dem:ag)
::
++ notif-ref
^- $-(json [@da ^index])
^- $-(json [(unit @da) ^index])
%- ot
:~ time+sd
:~ time+(mu sd)
index+index
==
++ graph-store-index
@ -70,11 +310,12 @@
%- of
:~ seen+ul
archive+notif-ref
unread-note+notif-ref
read-note+notif-ref
read-note+index
add-note+add
set-dnd+bo
read-count+stats-index
read-graph+dejs-path:resource
read-group+dejs-path:resource
read-each+read-graph-index
read-all+ul
==
@ -100,12 +341,21 @@
%unread-count (unread-count +.upd)
%remove-graph s+(enjs-path:resource +.upd)
%seen-index (seen-index +.upd)
%unreads (unreads +.upd)
%unreads (unreads +.upd)
%read-note (index +.upd)
%note-read (note-read +.upd)
::
?(%archive %read-note %unread-note)
%archive
(notif-ref +.upd)
==
::
++ note-read
|= [tim=@da idx=^index]
%- pairs
:~ time+s+(scot %ud tim)
index+(index idx)
==
::
++ stats-index
|= s=^stats-index
%+ frond -.s
@ -151,23 +401,21 @@
^- json
%- pairs
:~ unreads+(unread unreads.s)
notifications+a+(turn ~(tap in notifications.s) notif-ref)
last+(time last-seen.s)
==
++ added
|= [tim=@da idx=^index not=^notification]
|= [idx=^index not=^notification]
^- json
%- pairs
:~ time+s+(scot %ud tim)
index+(index idx)
:~ index+(index idx)
notification+(notification not)
==
::
++ notif-ref
|= [tim=@da idx=^index]
|= [tim=(unit @da) idx=^index]
^- json
%- pairs
:~ time+s+(scot %ud tim)
:~ [%time ?~(tim ~ s+(scot %ud u.tim))]
index+(index idx)
==
++ seen-index
@ -193,17 +441,15 @@
==
::
++ graph-index
|= $: group=resource
graph=resource
module=@t
|= $: graph=resource
mark=(unit mark)
description=@t
idx=index:graph-store
==
^- json
%- pairs
:~ group+s+(enjs-path:resource group)
graph+s+(enjs-path:resource graph)
module+s+module
:~ graph+s+(enjs-path:resource graph)
mark+s+(fall mark '')
description+s+description
index+(index:enjs:graph-store idx)
==
@ -222,7 +468,6 @@
^- json
%- pairs
:~ time+(time date)
read+b+read
contents+(^contents contents)
==
::
@ -259,11 +504,10 @@
==
::
++ timebox
|= [tim=@da arch=? l=(list [^index ^notification])]
|= [tim=(unit @da) l=(list [^index ^notification])]
^- json
%- pairs
:~ time+s+(scot %ud tim)
archive+b+arch
:~ time+`json`?~(tim ~ s+(scot %ud u.tim))
:- %notifications
^- json
:- %a

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

@ -144,6 +144,7 @@
%metadata-pull-hook
%group-view
%settings-store
%dm-hook
==
::
++ deft-fish :: default connects
@ -261,6 +262,7 @@
==
::
++ on-load
<<<<<<< HEAD
|^ |= [hood-version=@ud old=any-state]
=< se-abet =< se-view
=. sat (load-state old)
@ -340,6 +342,53 @@
(se-born | %home %group-view)
..on-load
--
=======
|= [hood-version=@ud old=any-state]
=< se-abet =< se-view
=. sat old
=. dev (~(gut by bin) ost *source)
=? ..on-load (lte hood-version %4)
~> %slog.0^leaf+"drum: starting os1 agents"
=> (se-born | %home %s3-store)
=> (se-born | %home %contact-view)
=> (se-born | %home %contact-hook)
=> (se-born | %home %contact-store)
=> (se-born | %home %metadata-hook)
=> (se-born | %home %metadata-store)
=> (se-born | %home %goad)
~> %slog.0^leaf+"drum: resubscribing to %dojo and %chat-cli"
=> (se-drop:(se-pull our.hid %dojo) | our.hid %dojo)
(se-drop:(se-pull our.hid %chat-cli) | our.hid %chat-cli)
=? ..on-load (lte hood-version %5)
(se-born | %home %file-server)
=? ..on-load (lte hood-version %7)
(se-born | %home %glob)
=? ..on-load (lte hood-version %8)
=> (se-born | %home %group-push-hook)
(se-born | %home %group-pull-hook)
=? ..on-load (lte hood-version %9)
(se-born | %home %graph-store)
=? ..on-load (lte hood-version %10)
=> (se-born | %home %graph-push-hook)
(se-born | %home %graph-pull-hook)
=? ..on-load (lte hood-version %11)
=> (se-born | %home %hark-graph-hook)
=> (se-born | %home %hark-group-hook)
=> (se-born | %home %hark-chat-hook)
=> (se-born | %home %hark-store)
=> (se-born | %home %observe-hook)
=> (se-born | %home %metadata-pull-hook)
=> (se-born | %home %metadata-push-hook)
(se-born | %home %herm)
=? ..on-load (lte hood-version %12)
=> (se-born | %home %contact-push-hook)
=> (se-born | %home %contact-pull-hook)
=> (se-born | %home %settings-store)
(se-born | %home %group-view)
=? ..on-load (lte hood-version %13)
(se-born | %home %dm-hook)
..on-load
>>>>>>> cd400dfa69059e211dc88f4ce5d53479b9da7542
::
++ reap-phat :: ack connect
|= [way=wire saw=(unit tang)]

14
pkg/arvo/lib/hood/kiln.hoon
View File

@ -55,6 +55,12 @@
cas=case ::
gim=?(%auto germ) ::
==
+$ kiln-fuse
$@ ~
$: syd=desk
bas=beak
con=(list [beak germ])
==
--
|= [bowl:gall state]
?> =(src our)
@ -381,6 +387,11 @@
?~ +< abet
abet:abet:(merge:(work syd) ali sud cas gim)
::
++ poke-fuse
|= k=kiln-fuse
?~ k abet
abet:(emit [%pass /kiln/fuse/[syd.k] %arvo %c [%fuse syd.k bas.k con.k]])
::
++ poke-cancel
|= a=@tas
abet:(emit %pass /cancel %arvo %c [%drop a])
@ -430,6 +441,7 @@
%kiln-info =;(f (f !<(_+<.f vase)) poke-info)
%kiln-label =;(f (f !<(_+<.f vase)) poke-label)
%kiln-merge =;(f (f !<(_+<.f vase)) poke-merge)
%kiln-fuse =;(f (f !<(_+<.f vase)) poke-fuse)
%kiln-mount =;(f (f !<(_+<.f vase)) poke-mount)
%kiln-ota =;(f (f !<(_+<.f vase)) poke:update)
%kiln-ota-info =;(f (f !<(_+<.f vase)) poke-ota-info)
@ -489,6 +501,8 @@
++ take |=(way=wire ?>(?=([@ ~] way) (work i.way))) :: general handler
++ take-mere ::
|= [way=wire are=(each (set path) (pair term tang))]
?. ?=([@ ~] way)
abet
abet:abet:(mere:(take way) are)
::
++ take-coup-fancy ::

7
pkg/arvo/lib/language-server/parser.hoon
View File

@ -21,7 +21,10 @@
(most ;~(plug com gaw) taut-rule)
::
%+ rune tis
;~(plug sym ;~(pfix gap fas (more fas urs:ab)))
;~(plug sym ;~(pfix gap stap))
::
%+ rune sig
;~((glue gap) sym wyde:vast stap)
::
%+ rune cen
;~(plug sym ;~(pfix gap ;~(pfix cen sym)))
@ -37,7 +40,7 @@
;~ (glue gap)
sym
;~(pfix cen sym)
;~(pfix fas (more fas urs:ab))
stap
==
::
%+ stag %tssg

11
pkg/arvo/lib/launch-store.hoon
View File

@ -71,7 +71,12 @@
[%'linkedUrl' s+linked-url.type]
==
::
%custom (frond %custom ~)
%custom
%+ frond %custom
%- pairs
:~ [%'linkedUrl' ?~(linked-url.type ~ s+u.linked-url.type)]
[%'image' ?~(image.type ~ s+u.image.type)]
==
==
::
++ terms
@ -105,10 +110,10 @@
[%'isShown' bo]
==
::
++ tile-type
++ tile-type
%- of
:~ [%basic basic]
[%custom ul]
[%custom (ot [%'linkedUrl' (mu so)] [%'image' (mu so)] ~)]
==
::
++ basic

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

@ -53,6 +53,7 @@
::
++ app-metadata-for-group
|= [group=resource =app-name:store]
^- associations:store
=/ =associations:store
(metadata-for-group group)
%- ~(gas by *associations:store)
@ -62,6 +63,7 @@
::
++ metadata-for-group
|= group=resource
^- associations:store
.^ associations:store
%gx (scot %p our.bowl) %metadata-store (scot %da now.bowl)
%group (snoc (en-path:resource group) %noun)
@ -69,6 +71,7 @@
::
++ md-resources-from-group
|= group=resource
^- (set md-resource:store)
=- (~(get ju -) group)
.^ (jug resource md-resource:store)
%gy
@ -80,6 +83,7 @@
::
++ peek-association
|= [app-name=term rid=resource]
^- (unit association:store)
.^ (unit association:store)
%gx (scot %p our.bowl) %metadata-store (scot %da now.bowl)
%metadata app-name (snoc (en-path:resource rid) %noun)
@ -87,6 +91,7 @@
::
++ peek-metadatum
|= =md-resource:store
^- (unit metadatum:store)
%+ bind (peek-association md-resource)
|=(association:store metadatum)
::
@ -95,4 +100,13 @@
^- (unit resource)
%+ bind (peek-association md-resource)
|=(association:store group)
::
++ graphs-of-group
|= group=resource
=/ =associations:store
(metadata-for-group group)
%+ murn ~(tap in ~(key by associations))
|= [=app-name:store rid=resource]
?.(=(%graph app-name) ~ `rid)
--

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

@ -271,6 +271,10 @@
~/ %on-poke
|= [=mark =vase]
^- (quip card:agent:gall agent:gall)
?: =(mark %kick)
?> (team:title [our src]:bowl)
:_ this
(kick:io (turn ~(val by sup.bowl) tail))^~
?: =(mark %push-hook-action)
?> (team:title our.bowl src.bowl)
=^ cards state
@ -300,8 +304,10 @@
unversioned
=/ =resource
(de-path:resource t.t.path)
=/ requested=@ud
(slav %ud i.t.t.t.t.t.path)
=/ =mark
(append-version:ver (slav %ud i.t.t.t.t.t.path))
(append-version:ver (min requested version.config))
?. (supported:ver mark)
:_ this
(fact-init-kick:io version+!>(min-version.config))
@ -476,7 +482,7 @@
%+ turn ~(tap by paths)
|= [fact-ver=@ud paths=(set path)]
=/ =mark
(append-version:ver fact-ver)
(append-version:ver (min version.config fact-ver))
(fact:io (convert-from:ver mark q.cage) ~(tap in paths))
:: TODO: deprecate
++ unversioned

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

@ -106,6 +106,13 @@
^- simple-payload:http
:_ `octs
[200 [['content-type' 'image/png'] ?:(cache [max-1-wk ~] ~)]]
::
++ svg-response
=| cache=?
|= =octs
^- simple-payload:http
:_ `octs
[200 [['content-type' 'image/svg+xml'] ?:(cache [max-1-wk ~] ~)]]
::
++ ico-response
|= =octs

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

@ -490,7 +490,7 @@
=/ m (strand ,vase)
^- form:m
;< =riot:clay bind:m
(warp ship desk ~ %sing %b case /[mak])
(warp ship desk ~ %sing %e case /[mak])
?~ riot
(strand-fail %build-nave >arg< ~)
?> =(%nave p.r.u.riot)

12
pkg/arvo/mar/btc-provider/action.hoon Normal file
View File

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

14
pkg/arvo/mar/btc-provider/status.hoon Normal file
View File

@ -0,0 +1,14 @@
/- *btc-provider
/+ bitcoin-json
|_ sta=status
++ grad %noun
++ grow
|%
++ noun sta
++ json (status:enjs:bitcoin-json sta)
--
++ grab
|%
++ noun status
--
--

12
pkg/arvo/mar/btc-provider/update.hoon Normal file
View File

@ -0,0 +1,12 @@
/- *btc-provider
|_ upd=update
++ grad %noun
++ grow
|%
++ noun upd
--
++ grab
|%
++ noun update
--
--

12
pkg/arvo/mar/btc-wallet/action.hoon Normal file
View File

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

14
pkg/arvo/mar/btc-wallet/command.hoon Normal file
View File

@ -0,0 +1,14 @@
/- *btc-wallet
/+ bitcoin-json
|_ com=command
++ grad %noun
++ grow
|%
++ noun com
--
++ grab
|%
++ noun command
++ json command:dejs:bitcoin-json
--
--

12
pkg/arvo/mar/btc-wallet/internal.hoon Normal file
View File

@ -0,0 +1,12 @@
/- *btc-wallet
|_ intr=internal
++ grad %noun
++ grow
|%
++ noun intr
--
++ grab
|%
++ noun internal
--
--

14
pkg/arvo/mar/btc-wallet/update.hoon Normal file
View File

@ -0,0 +1,14 @@
/- *btc-wallet
/+ bitcoin-json
|_ upd=update
++ grad %noun
++ grow
|%
++ noun upd
++ json (update:enjs:bitcoin-json upd)
--
++ grab
|%
++ noun update
--
--

18
pkg/arvo/mar/dm-hook-action.hoon Normal file
View File

@ -0,0 +1,18 @@
/+ *dm-hook
|_ act=action
++ grad %noun
++ grow
|%
++ noun act
++ json
%+ frond:enjs:format %dm-hook-action
(action:enjs act)
--
::
++ grab
|%
++ noun action
++ json action:dejs
--
--

14
pkg/arvo/mar/graph/indexed-post.hoon Normal file
View File

@ -0,0 +1,14 @@
/- *post
|_ i=indexed-post
++ grow
|%
++ noun i
--
::
++ grab
|%
++ noun indexed-post
--
::
++ grad %noun
--

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

@ -4,6 +4,11 @@
|%
++ noun i
::
++ graph-indexed-post
^- indexed-post
?> ?=([@ ~] index.p.i)
i
::
++ graph-permissions-add
|= vip=vip-metadata:met
^- permissions:graph
@ -30,13 +35,10 @@
=- [- post(index -)]
[atom ~]
--
++ grab
::
++ grab
|%
++ noun
|= p=*
=/ ip ;;(indexed-post p)
?> ?=([@ ~] index.p.ip)
ip
++ noun indexed-post
--
::
++ grad %noun

26
pkg/arvo/mar/graph/validator/dm.hoon Normal file
View File

@ -0,0 +1,26 @@
/- *post, met=metadata-store, graph=graph-store, hark=hark-graph-hook
|_ i=indexed-post
++ grow
|%
++ noun i
::
++ graph-indexed-post
^- indexed-post
?> ?=(?([@ ~] [@ @ ~]) index.p.i)
?> (lth i.index.p.i (bex 128))
i
::
++ notification-kind
^- (unit notif-kind:hark)
?+ index.p.i ~
[@ @ ~] `[%message [1 2] %count %none]
==
::
--
++ grab
|%
++ noun indexed-post
--
::
++ grad %noun
--

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

@ -4,6 +4,28 @@
|%
++ noun i
::
++ graph-indexed-post
^- indexed-post
?+ index.p.i ~|(index+index.p.i !!)
:: top-level link post; title and url
::
[@ ~]
?> ?=([[%text @] $%([%url @] [%reference *]) ~] contents.p.i)
i
::
:: comment on link post; container structure
::
[@ @ ~]
?> ?=(~ contents.p.i)
i
::
:: comment on link post; comment text
::
[@ @ @ ~]
?> ?=(^ contents.p.i)
i
==
::
++ graph-permissions-add
|= vip=vip-metadata:met
^- permissions:graph
@ -48,28 +70,7 @@
--
++ grab
|%
++ noun
|= p=*
=/ ip ;;(indexed-post p)
?+ index.p.ip ~|(index+index.p.ip !!)
:: top-level link post; title and url
::
[@ ~]
?> ?=([[%text @] $%([%url @] [%reference *]) ~] contents.p.ip)
ip
::
:: comment on link post; container structure
::
[@ @ ~]
?> ?=(~ contents.p.ip)
ip
::
:: comment on link post; comment text
::
[@ @ @ ~]
?> ?=(^ contents.p.ip)
ip
==
++ noun indexed-post
--
++ grad %noun
--

14
pkg/arvo/mar/graph/validator/post.hoon
View File

@ -3,6 +3,12 @@
++ grow
|%
++ noun i
::
++ graph-indexed-post
^- indexed-post
?> ?=(^ contents.p.i)
i
::
++ graph-permissions-add
|= vip=vip-metadata:met
^- permissions:graph
@ -40,13 +46,7 @@
--
++ grab
|%
:: +noun: validate post
::
++ noun
|= p=*
=/ ip ;;(indexed-post p)
?> ?=(^ contents.p.ip)
ip
++ noun indexed-post
--
::
++ grad %noun

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

@ -3,6 +3,44 @@
++ grow
|%
++ noun i
::
++ graph-indexed-post
^- indexed-post
?+ index.p.i !!
:: top level post must have no content
[@ ~]
?> ?=(~ contents.p.i)
i
:: container for revisions
::
[@ %1 ~]
?> ?=(~ contents.p.i)
i
:: specific revision
:: first content is the title
:: revisions are numbered by the revision count
:: starting at one
[@ %1 @ ~]
?> ?=([* * *] contents.p.i)
?> ?=(%text -.i.contents.p.i)
i
:: container for comments
::
[@ %2 ~]
?> ?=(~ contents.p.i)
i
:: container for comment revisions
::
[@ %2 @ ~]
?> ?=(~ contents.p.i)
i
:: specific comment revision
::
[@ %2 @ @ ~]
?> ?=(^ contents.p.i)
i
==
::
++ graph-permissions-add
|= vip=vip-metadata:met
^- permissions:graph
@ -55,45 +93,7 @@
--
++ grab
|%
:: +noun: validate publish note
::
++ noun
|= p=*
=/ ip ;;(indexed-post p)
?+ index.p.ip !!
:: top level post must have no content
[@ ~]
?> ?=(~ contents.p.ip)
ip
:: container for revisions
::
[@ %1 ~]
?> ?=(~ contents.p.ip)
ip
:: specific revision
:: first content is the title
:: revisions are numbered by the revision count
:: starting at one
[@ %1 @ ~]
?> ?=([* * *] contents.p.ip)
?> ?=(%text -.i.contents.p.ip)
ip
:: container for comments
::
[@ %2 ~]
?> ?=(~ contents.p.ip)
ip
:: container for comment revisions
::
[@ %2 @ ~]
?> ?=(~ contents.p.ip)
ip
:: specific comment revision
::
[@ %2 @ @ ~]
?> ?=(^ contents.p.ip)
ip
==
++ noun indexed-post
--
::
++ grad %noun

1
pkg/arvo/mar/lens/command.hoon
View File

@ -46,6 +46,7 @@
import-all+(ot base64-jam+so ~)
as+(ot mark+(su sym) next+source ~)
hoon+(ot code+so next+source ~)
cancel+none
==
++ none |=(^^json (some ~))
++ sink

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

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

84
pkg/arvo/sur/bitcoin.hoon Normal file
View File

@ -0,0 +1,84 @@
:: sur/btc.hoon
:: Utilities for working with BTC data types and transactions
::
:: chyg: whether account is (non-)change. 0 or 1
:: bytc: "btc-byts" with dat cast to @ux
|%
+$ network ?(%main %testnet)
+$ hexb [wid=@ dat=@ux] :: hex byts
+$ bits [wid=@ dat=@ub]
+$ xpub @ta
+$ address
$% [%base58 @uc]
[%bech32 cord]
==
+$ fprint hexb
+$ bipt $?(%44 %49 %84)
+$ chyg $?(%0 %1)
+$ idx @ud
+$ hdkey [=fprint pubkey=hexb =network =bipt =chyg =idx]
+$ sats @ud
+$ vbytes @ud
+$ txid hexb
+$ utxo [pos=@ =txid height=@ value=sats recvd=(unit @da)]
++ address-info
$: =address
confirmed-value=sats
unconfirmed-value=sats
utxos=(set utxo)
==
++ tx
|%
+$ data
$: is=(list input)
os=(list output)
locktime=@ud
nversion=@ud
segwit=(unit @ud)
==
+$ val
$: =txid
pos=@ud
=address
value=sats
==
:: included: whether tx is in the mempool or blockchain
::
+$ info
$: included=?
=txid
confs=@ud
recvd=(unit @da)
inputs=(list val)
outputs=(list val)
==
+$ input
$: =txid
pos=@ud
sequence=hexb
script-sig=(unit hexb)
pubkey=(unit hexb)
value=sats
==
+$ output
$: script-pubkey=hexb
value=sats
==
--
++ psbt
|%
+$ base64 cord
+$ in [=utxo rawtx=hexb =hdkey]
+$ out [=address hk=(unit hdkey)]
+$ target $?(%input %output)
+$ keyval [key=hexb val=hexb]
+$ map (list keyval)
--
++ ops
|%
++ op-dup 118
++ op-equalverify 136
++ op-hash160 169
++ op-checksig 172
--
--

80
pkg/arvo/sur/btc-provider.hoon Normal file
View File

@ -0,0 +1,80 @@
/- *bitcoin, resource
|%
+$ host-info
$: api-url=@t
connected=?
=network
block=@ud
clients=(set ship)
==
+$ whitelist
$: public=?
kids=?
users=(set ship)
groups=(set resource:resource)
==
::
+$ whitelist-target
$% [%public ~]
[%kids ~]
[%users users=(set ship)]
[%groups groups=(set resource:resource)]
==
+$ command
$% [%set-credentials api-url=@t =network]
[%add-whitelist wt=whitelist-target]
[%remove-whitelist wt=whitelist-target]
==
+$ action
$% [%address-info =address]
[%tx-info txid=hexb]
[%raw-tx txid=hexb]
[%broadcast-tx rawtx=hexb]
[%ping ~]
[%block-info block=(unit @ud)]
==
::
+$ result
$% [%address-info =address utxos=(set utxo) used=? block=@ud]
[%tx-info =info:tx]
[%raw-tx txid=hexb rawtx=hexb]
[%broadcast-tx txid=hexb broadcast=? included=?]
[%block-info =network block=@ud fee=(unit sats) blockhash=hexb blockfilter=hexb]
==
+$ error
$% [%not-connected status=@ud]
[%bad-request status=@ud]
[%no-auth status=@ud]
[%rpc-error ~]
==
+$ update (each result error)
+$ status
$% [%connected =network block=@ud fee=(unit sats)]
[%new-block =network block=@ud fee=(unit sats) blockhash=hexb blockfilter=hexb]
[%disconnected ~]
==
::
++ rpc-types
|%
+$ action
$% [%get-address-info =address]
[%get-tx-vals txid=hexb]
[%get-raw-tx txid=hexb]
[%broadcast-tx rawtx=hexb]
[%get-block-count ~]
[%get-block-info block=(unit @ud)]
==
::
+$ result
$% [%get-address-info =address utxos=(set utxo) used=? block=@ud]
[%get-tx-vals =info:tx]
[%get-raw-tx txid=hexb rawtx=hexb]
[%create-raw-tx rawtx=hexb]
[%broadcast-tx txid=hexb broadcast=? included=?]
[%get-block-count block=@ud]
[%get-block-info block=@ud fee=(unit sats) blockhash=hexb blockfilter=hexb]
==
--
--
::

167
pkg/arvo/sur/btc-wallet.hoon Normal file
View File

@ -0,0 +1,167 @@
/- *bitcoin, bp=btc-provider
/+ bip32
|%
+$ params [batch-size=@ud fam-limit=@ud piym-limit=@ud]
+$ provider [host=ship connected=?]
+$ block @ud
+$ btc-state [=block fee=(unit sats) t=@da]
+$ payment [pend=(unit txid) =xpub =address payer=ship value=sats note=(unit @t)]
+$ piym
$: ps=(map ship payment)
pend=(map txid payment)
num-fam=(map ship @ud)
==
+$ poym [txbu=(unit txbu) note=(unit @t)]
::
:: command: run from the CLI or as API calls by our ship
::
+$ command
$% [%set-provider provider=(unit ship)]
[%check-provider provider=ship]
[%check-payee payee=ship]
[%set-current-wallet =xpub]
[%add-wallet =xpub =fprint scan-to=(unit scon) max-gap=(unit @ud) confs=(unit @ud)]
[%delete-wallet =xpub]
[%init-payment-external =address value=sats feyb=sats note=(unit @t)]
[%init-payment payee=ship value=sats feyb=sats note=(unit @t)]
[%broadcast-tx txhex=cord]
[%gen-new-address ~]
==
:: action: how peers poke us
::
+$ action
$% [%gen-pay-address value=sats note=(unit @t)]
[%give-pay-address =address value=sats]
[%expect-payment =txid value=sats]
==
:: internal: actions that simply make the state machine more explicit
::
+$ internal
$% [%add-poym-raw-txi =txid rawtx=hexb]
[%close-pym ti=info:tx]
[%fail-broadcast-tx =txid]
[%succeed-broadcast-tx =txid]
==
::
:: Wallet Types
::
:: nixt: next indices to generate addresses from (non-change/change)
:: addi: HD path along with UTXOs
:: wach: map for watched addresses.
:: Membership implies the address is known by outside parties or had prior activity
:: scon: indices to initially scan to in (non-)change accounts
:: defaults to 2^32-1 (i.e. all the addresses, ~4B)
:: wilt: copulates with thousands of indices to form addresses
::
++ max-index (dec (pow 2 32))
+$ nixt (pair idx idx)
+$ addi [used=? =chyg =idx utxos=(set utxo)]
+$ wach (map address addi)
+$ scon $~([max-index max-index] (pair idx idx))
+$ wilt _bip32
+$ wamp [prv=@ pub=[x=@ y=@] cad=@ dep=@ud ind=@ud pif=@]
::
:: walt: wallet datastructure
:: scanned: whether the wallet's addresses have been checked for prior activity
:: scan-to
:: max-gap: maximum number of consec blank addresses before wallet stops scanning
:: confs: confirmations required (after this is hit for an address, wallet stops refreshing it)
::
+$ walt-0
$: =xpub
=network
=fprint
=wilt
=bipt
=wach
=nixt
scanned=?
scan-to=scon
max-gap=@ud
confs=@ud
==
::
+$ walt
$: =xpub
=network
=fprint
=wamp
=bipt
=wach
=nixt
scanned=?
scan-to=scon
max-gap=@ud
confs=@ud
==
:: batch: indexes to scan for a given chyg
:: scans: all scans underway (batches)
::
+$ batch [todo=(set idx) endpoint=idx has-used=?]
+$ scans (map [xpub chyg] batch)
::
:: insel: a selected utxo for input to a transaction
:: pmet: optional payment metadata
:: feyb: fee per byte in sats
:: txi/txo: input/output for a transaction being built
:: - txo has an hdkey if it's a change account
:: - by convention, first output of txo is to the payee, if one is present
:: txbu: tx builder -- all information needed to make a transaction for signing
::
+$ insel [=utxo =chyg =idx]
+$ feyb sats
+$ txi [=utxo rawtx=(unit hexb) =hdkey]
+$ txo [=address value=sats hk=(unit hdkey)]
+$ txbu
$: =xpub
payee=(unit ship)
=vbytes
txis=(list txi)
txos=(list txo)
signed-tx=(unit hexb)
==
:: hest: an entry in the history log
::
+$ hest
$: =xpub
=txid
confs=@ud
recvd=(unit @da)
inputs=(list [=val:tx s=(unit ship)])
outputs=(list [=val:tx s=(unit ship)])
note=(unit @t)
==
+$ history (map txid hest)
::
+$ error
$? %cant-pay-ourselves
%no-comets
%no-dust
%tx-being-signed
%insufficient-balance
%broadcast-fail
==
:: data to send to the frontend
::
+$ update
$% $: %initial
provider=(unit provider)
wallet=(unit xpub)
balance=(unit [confirmed=sats unconfirmed=sats])
=history
=btc-state
address=(unit address)
==
[%broadcast-success ~]
[%change-provider provider=(unit provider)]
[%change-wallet wallet=(unit xpub) balance=(unit [p=sats q=sats]) =history]
[%psbt pb=@t fee=sats]
[%btc-state =btc-state]
[%new-tx =hest]
[%cancel-tx =txid]
[%new-address =address]
[%balance balance=(unit [confirmed=sats unconfirmed=sats])]
[%error =error]
==
::
--

25
pkg/arvo/sur/dm-hook.hoon Normal file
View File

@ -0,0 +1,25 @@
|%
++ action
=< action
|%
::
++ action
$% accept
decline
pendings
screen
==
::
+$ accept
[%accept =ship]
::
+$ decline
[%decline =ship]
::
+$ pendings
[%pendings ships=(set ship)]
::
+$ screen
[%screen screen=?]
--
--

4
pkg/arvo/sur/glob.hoon
View File

@ -1,3 +1,5 @@
|%
+$ glob (map path mime)
+$ glob (map path mime)
+$ glob-details [hash=@uv glob=(unit (each glob tid=@ta))]
+$ globs (map serve-path=path glob-details)
--

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

@ -73,8 +73,8 @@
::
++ one
|%
++ orm ((ordered-map atom node) gth)
++ orm-log ((ordered-map time logged-update) gth)
++ orm ((on atom node) gth)
++ orm-log ((on time logged-update) gth)
::
+$ graph ((mop atom node) gth)
+$ marked-graph [p=graph q=(unit mark)]

274
pkg/arvo/sur/hark-store.hoon
View File

@ -1,6 +1,86 @@
/- chat-store, graph-store, post, *resource, group-store, metadata-store
^?
|%
+$ index
$% $: %graph
graph=resource
mark=(unit mark)
description=@t
=index:graph-store
==
[%group group=resource description=@t]
==
::
+$ group-contents
$~ [%add-members *resource ~]
$>(?(%add-members %remove-members) update:group-store)
::
+$ notification
[date=@da read=? =contents]
::
+$ contents
$% [%graph =(list post:post)]
[%group =(list group-contents)]
==
::
+$ timebox
(map index notification)
::
+$ notifications
((mop @da timebox) gth)
::
+$ action
$% [%add-note =index =notification]
:: if .time is ~, then archiving unread notification
:: else, archiving read notification
[%archive time=(unit @da) =index]
::
[%unread-count =stats-index =time]
[%read-count =stats-index]
::
[%unread-each =stats-index ref=index:graph-store time=@da]
[%read-each =stats-index ref=index:graph-store]
::
[%read-note =index]
::
[%seen-index time=@da =stats-index]
::
[%read-graph =resource]
[%read-group =resource]
[%remove-graph =resource]
::
[%read-all ~]
[%set-dnd dnd=?]
[%seen ~]
==
::
++ stats-index
$% [%graph graph=resource =index:graph-store]
[%group group=resource]
==
::
+$ indexed-notification
[index notification]
::
+$ stats
[=unreads last-seen=@da]
::
+$ unreads
$% [%count num=@ud]
[%each indices=(set index:graph-store)]
==
::
+$ update
$% action
[%more more=(list update)]
[%added =index =notification]
[%note-read =time =index]
[%timebox time=(unit @da) =(list [index notification])]
[%count count=@ud]
[%clear =stats-index]
[%unreads unreads=(list [stats-index stats])]
==
:: historical
++ state-zero
|%
+$ state
@ -20,7 +100,7 @@
(map index notification)
::
+$ index
$% [%graph group=resource graph=resource module=@t description=@t]
$% [%graph graph=resource module=@t description=@t]
[%group group=resource description=@t]
[%chat chat=path mention=?]
==
@ -68,6 +148,17 @@
dnd=_|
==
::
+$ index
$% $: %graph
group=resource
graph=resource
module=@t
description=@t
=index:graph-store
==
[%group group=resource description=@t]
==
::
++ orm
((ordered-map @da timebox) gth)
::
@ -106,6 +197,17 @@
++ orm
((ordered-map @da timebox) gth)
::
+$ index
$% $: %graph
group=resource
graph=resource
module=@t
description=@t
=index:graph-store
==
[%group group=resource description=@t]
==
::
+$ notification
[date=@da read=? =contents]
::
@ -122,80 +224,98 @@
::
--
::
+$ index
$% $: %graph
group=resource
graph=resource
module=@t
description=@t
=index:graph-store
==
[%group group=resource description=@t]
==
::
+$ group-contents
$~ [%add-members *resource ~]
$>(?(%add-members %remove-members) update:group-store)
::
+$ notification
[date=@da read=? =contents]
::
+$ contents
$% [%graph =(list post:post)]
[%group =(list group-contents)]
==
::
+$ timebox
(map index notification)
::
+$ notifications
((mop @da timebox) gth)
::
+$ action
$% [%add-note =index =notification]
[%archive time=@da index]
::
[%unread-count =stats-index =time]
[%read-count =stats-index]
::
::
[%unread-each =stats-index ref=index:graph-store time=@da]
[%read-each =stats-index ref=index:graph-store]
::
[%read-note time=@da index]
[%unread-note time=@da index]
::
[%seen-index time=@da =stats-index]
[%remove-graph =resource]
::
[%read-all ~]
[%set-dnd dnd=?]
[%seen ~]
==
::
++ stats-index
$% [%graph graph=resource =index:graph-store]
[%group group=resource]
==
::
+$ indexed-notification
[index notification]
::
+$ stats
[notifications=(set [time index]) =unreads last-seen=@da]
::
+$ unreads
$% [%count num=@ud]
[%each indices=(set index:graph-store)]
==
::
+$ update
$% action
[%more more=(list update)]
[%added time=@da =index =notification]
[%timebox time=@da archived=? =(list [index notification])]
[%count count=@ud]
[%clear =stats-index]
[%unreads unreads=(list [stats-index stats])]
==
++ state-four
=< base-state
|%
++ orm
((ordered-map @da timebox) gth)
::
+$ base-state
$: unreads-each=(jug stats-index index:graph-store)
unreads-count=(map stats-index @ud)
last-seen=(map stats-index @da)
=notifications
archive=notifications
current-timebox=@da
dnd=_|
==
::
+$ index
$% $: %graph
group=resource
graph=resource
module=@t
description=@t
=index:graph-store
==
[%group group=resource description=@t]
==
::
+$ group-contents
$~ [%add-members *resource ~]
$>(?(%add-members %remove-members) update:group-store)
::
+$ notification
[date=@da read=? =contents]
::
+$ contents
$% [%graph =(list post:post)]
[%group =(list group-contents)]
==
::
+$ timebox
(map index notification)
::
+$ notifications
((mop @da timebox) gth)
::
+$ action
$% [%add-note =index =notification]
[%archive time=@da index]
::
[%unread-count =stats-index =time]
[%read-count =stats-index]
::
::
[%unread-each =stats-index ref=index:graph-store time=@da]
[%read-each =stats-index ref=index:graph-store]
::
[%read-note time=@da index]
[%unread-note time=@da index]
::
[%seen-index time=@da =stats-index]
::
[%remove-graph =resource]
::
[%read-all ~]
[%set-dnd dnd=?]
[%seen ~]
==
::
++ stats-index
$% [%graph graph=resource =index:graph-store]
[%group group=resource]
==
::
+$ indexed-notification
[index notification]
::
+$ stats
[notifications=(set [time index]) =unreads last-seen=@da]
::
+$ unreads
$% [%count num=@ud]
[%each indices=(set index:graph-store)]
==
::
+$ update
$% action
[%more more=(list update)]
[%added time=@da =index =notification]
[%timebox time=@da archived=? =(list [index notification])]
[%count count=@ud]
[%clear =stats-index]
[%unreads unreads=(list [stats-index stats])]
==
--
--

12
pkg/arvo/sur/launch-store.hoon
View File

@ -1,4 +1,14 @@
|%
+$ tiles-0 (map term tile-0)
+$ tile-0
$: type=tile-type-0
is-shown=?
==
+$ tile-type-0
$% [%basic title=cord icon-url=cord linked-url=cord]
[%custom ~]
==
::
+$ tiles (map term tile)
+$ tile-ordering (list term)
::
@ -9,7 +19,7 @@
::
+$ tile-type
$% [%basic title=cord icon-url=cord linked-url=cord]
[%custom ~]
[%custom linked-url=(unit cord) image=(unit cord)]
==
::
+$ action

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

@ -19,6 +19,7 @@
[%import app=@t base64-jam=@t]
[%export-all ~]
[%import-all base64-jam=@t]
[%cancel ~]
==
++ sink
$% [%stdout ~]

28
pkg/arvo/sys/arvo.hoon
View File

@ -252,11 +252,13 @@
:: %what: update from files
:: %whey: produce $mass :: XX remove, scry
:: %verb: toggle laconicity
:: %whiz: prime vane caches
::
$% [%trim p=@ud]
[%what p=(list (pair path (cask)))]
[%whey ~]
[%verb p=(unit ?)]
[%whiz ~]
==
+$ wasp
:: %crud: reroute $ovum with $goof
@ -291,14 +293,23 @@
|=(b=beam =*(s scot `path`[(s %p p.b) q.b (s r.b) s.b]))
::
++ de-beam
~/ %de-beam
|= p=path
^- (unit beam)
?. ?=([@ @ @ *] p) ~
?~ who=(slaw %p i.p) ~
?~ des=?~(i.t.p (some %$) (slaw %tas i.t.p)) ~ :: XX +sym ;~(pose low (easy %$))
?~ ved=(slay i.t.t.p) ~
?. ?=([%$ case] u.ved) ~
`(unit beam)`[~ [`ship`u.who `desk`u.des `case`p.u.ved] t.t.t.p]
?~ ved=(de-case i.t.t.p) ~
`[[`ship`u.who `desk`u.des u.ved] t.t.t.p]
::
++ de-case
~/ %de-case
|= =knot
^- (unit case)
?^ num=(slaw %ud knot) `[%ud u.num]
?^ wen=(slaw %da knot) `[%da u.wen]
?~ lab=(slaw %tas knot) ~
`[%tas u.lab]
::
++ en-omen
|= [vis=view bem=beam]
@ -308,6 +319,7 @@
~(rent co [%many $/tas/way.vis $/tas/car.vis ~])
::
++ de-omen
~/ %de-omen
|= pax=path
^- (unit [vis=view bem=beam])
?~ pax ~
@ -1000,8 +1012,11 @@
++ settle
|= van=vase
^- (pair vase worm)
=/ [rig=vase wor=worm] (~(slym wa *worm) van *vane-sample)
[van +:(~(slap wa wor) rig [%limb %scry])]
=| sac=worm
=^ rig=vase sac (~(slym wa sac) van *vane-sample)
=^ gat=vase sac (~(slap wa sac) rig [%limb %scry])
=^ pro=vase sac (~(slap wa sac) gat [%limb %$])
[van +:(~(mint wa sac) p.pro [%$ 7])]
::
:: XX pass identity to preserve behavior?
::
@ -1470,6 +1485,9 @@
%verb ..pith(lac.fad ?~(p.waif !lac.fad u.p.waif))
%what ~(kel what p.waif)
%whey ..pith(out [[//arvo mass/whey] out])
::
%whiz
..pith(van.mod (~(run by van.mod) |=(vane (settle:va:part vase))))
==
::
++ peek

93
pkg/arvo/sys/hoon.hoon
View File

@ -259,6 +259,8 @@
++ head |*(^ ,:+<-) :: get head
++ same |*(* +<) :: identity
::
++ succ |=(@ +(+<)) :: successor
::
++ tail |*(^ ,:+<+) :: get tail
++ test |=(^ =(+<- +<+)) :: equality
::
@ -5452,12 +5454,14 @@
:::: 4k: atom printing
::
++ co
!:
~% %co ..co ~
=< |_ lot=coin
++ rear |=(rom=tape rend(rep rom))
++ rent `@ta`(rap 3 rend)
++ rent ~+ `@ta`(rap 3 rend)
++ rend
^- tape
~+
?: ?=(%blob -.lot)
['~' '0' ((v-co 1) (jam p.lot))]
?: ?=(%many -.lot)
@ -5602,18 +5606,17 @@
|= a=dn
?: ?=([%i *] a) (weld ?:(s.a "inf" "-inf") rep)
?: ?=([%n *] a) (weld "nan" rep)
=/ f=(pair tape @)
%. a.a
%+ ed-co(rep ~) [10 1]
|=([a=? b=@ c=tape] [~(d ne b) ?.(a c ['.' c])])
=. e.a (sum:si e.a (sun:si (dec q.f)))
=/ res
%+ weld p.f
?~ e.a
rep
%+ weld ?:((syn:si e.a) "e" "e-")
((d-co 1) (abs:si e.a))
?:(s.a res ['-' res])
=; rep ?:(s.a rep ['-' rep])
=/ f ((d-co 1) a.a)
=^ e e.a
=/ e=@s (sun:si (lent f))
=/ sci :(sum:si e.a e -1)
?: (syn:si (dif:si e.a --3)) [--1 sci] :: 12000 -> 12e3 e>+2
?: !(syn:si (dif:si sci -2)) [--1 sci] :: 0.001 -> 1e-3 e<-2
[(sum:si sci --1) --0] :: 1.234e2 -> '.'@3 -> 123 .4
=? rep !=(--0 e.a)
:(weld ?:((syn:si e.a) "e" "e-") ((d-co 1) (abs:si e.a)))
(weld (ed-co e f) rep)
::
++ s-co
|= esc=(list @) ^- tape
@ -5659,20 +5662,13 @@
:: - used only for @r* floats
::
++ ed-co
|= [[bas=@ min=@] par=$-([? @ tape] tape)]
=| [fir=? cou=@ud]
|= hol=@
^- [tape @]
?: &(=(0 hol) =(0 min))
[rep cou]
=/ [dar=@ rad=@] (dvr hol bas)
%= $
min ?:(=(0 min) 0 (dec min))
hol dar
rep (par &(=(0 dar) !fir) rad rep)
fir |
cou +(cou)
==
|= [exp=@s int=tape] ^- tape
=/ [pos=? dig=@u] [=(--1 (cmp:si exp --0)) (abs:si exp)]
?. pos
(into (weld (reap +(dig) '0') int) 1 '.')
=/ len (lent int)
?: (lth dig len) (into int dig '.')
(weld int (reap (sub dig len) '0'))
::
:: +ox-co: format '.'-separated digit sequences in numeric base
::
@ -5965,9 +5961,8 @@
::
++ spat |=(pax=path (crip (spud pax))) :: render path to cord
++ spud |=(pax=path ~(ram re (smyt pax))) :: render path to tape
++ stab :: parse cord to path
=+ fel=;~(pfix fas (more fas urs:ab))
|=(zep=@t `path`(rash zep fel))
++ stab |=(zep=@t `path`(rash zep stap)) :: parse cord to path
++ stap ;~(pfix fas (more fas urs:ab)) :: path parser
::
:::: 4n: virtualization
::
@ -6627,7 +6622,7 @@
+$ seminoun
:: partial noun; blocked subtrees are ~
::
$~ [[%full ~] ~]
$~ [[%full / ~ ~] ~]
[mask=stencil data=noun]
::
:: +stencil: noun knowledge map
@ -8771,6 +8766,7 @@
%peek peek
%repo repo
%rest rest
%sink sink
%tack tack
%toss toss
%wrap wrap
@ -10845,7 +10841,7 @@
|- ^- type
?~ lov sut
$(lov t.lov, sut (face i.lov sut))
:: ::
::
++ sint :: reduce by reference
|= $: :: hod: expand holds
::
@ -10918,6 +10914,39 @@
%- ~(gas in *(set type))
(turn leg |=([p=type q=hoon] (play(sut p) q)))
::
++ sink
~/ %sink
|^ ^- cord
?- sut
%void 'void'
%noun 'noun'
[%atom *] (rap 3 'atom ' p.sut ' ' ?~(q.sut '~' u.q.sut) ~)
[%cell *] (rap 3 'cell ' (mup p.sut) ' ' (mup q.sut) ~)
[%face *] (rap 3 'face ' ?@(p.sut p.sut (mup p.sut)) ' ' (mup q.sut) ~)
[%fork *] (rap 3 'fork ' (mup p.sut) ~)
[%hint *] (rap 3 'hint ' (mup p.sut) ' ' (mup q.sut) ~)
[%hold *] (rap 3 'hold ' (mup p.sut) ' ' (mup q.sut) ~)
::
[%core *]
%+ rap 3
:~ 'core '
(mup p.sut)
' '
?~(p.p.q.sut '~' u.p.p.q.sut)
' '
q.p.q.sut
' '
r.p.q.sut
' '
(mup q.q.sut)
' '
(mup p.r.q.sut)
==
==
::
++ mup |=(* (scot %p (mug +<)))
--
::
++ take
|= [vit=vein duz=$-(type type)]
^- (pair axis type)

10
pkg/arvo/sys/lull.hoon
View File

@ -761,6 +761,11 @@
her=@p dem=desk cas=case :: source
how=germ :: method
== ::
$: %fuse :: merge many
des=desk :: target desk
bas=beak :: base desk
con=(list [beak germ]) :: merges
==
[%mont pot=term bem=beam] :: mount to unix
[%dirk des=desk] :: mark mount dirty
[%ogre pot=$@(desk beam)] :: delete mount point
@ -927,6 +932,7 @@
:: /- sur-file :: surface imports from /sur
:: /+ lib-file :: library imports from /lib
:: /= face /path :: imports built hoon file at path
:: /~ face type /path :: imports built hoon files from directory
:: /% face %mark :: imports mark definition from /mar
:: /$ face %from %to :: imports mark converter from /mar
:: /* face %mark /path :: unbuilt file imports, as mark
@ -935,6 +941,7 @@
$: sur=(list taut)
lib=(list taut)
raw=(list [face=term =path])
raz=(list [face=term =spec =path])
maz=(list [face=term =mark])
caz=(list [face=term =mars])
bar=(list [face=term =mark =path])
@ -954,7 +961,6 @@
$_
^?
|%
++ bunt *typ
++ diff |~([old=typ new=typ] *dif)
++ form *mark
++ join |~([a=dif b=dif] *(unit (unit dif)))
@ -969,7 +975,6 @@
+$ dais
$_ ^|
|_ sam=vase
++ bunt sam
++ diff |~(new=_sam *vase)
++ form *mark
++ join |~([a=vase b=vase] *(unit (unit vase)))
@ -2092,6 +2097,7 @@
[%g task:gall]
[%i task:iris]
[%j task:jael]
[%$ %whiz ~]
[@tas %meta vase]
==
:: full vane names are required in vanes

36
pkg/arvo/sys/vane/ames.hoon
View File

@ -1944,11 +1944,11 @@
=/ =bone bone.shut-packet
::
?: ?=(%& -.meat.shut-packet)
=+ ?~ dud ~
=+ ?. &(?=(^ dud) msg.veb) ~
%. ~
%+ slog
leaf+"ames: {<her.channel>} fragment crashed {<mote.u.dud>}"
?.(msg.veb ~ tang.u.dud)
%- slog
:_ tang.u.dud
leaf+"ames: {<her.channel>} fragment crashed {<mote.u.dud>}"
(run-message-sink bone %hear lane shut-packet ?=(~ dud))
:: Just try again on error, printing trace
::
@ -1967,20 +1967,12 @@
++ on-memo
|= [=bone payload=* valence=?(%plea %boon)]
^+ peer-core
:: if we haven't been trying to talk to %live, reset timer
::
=? last-contact.qos.peer-state
?& ?=(%live -.qos.peer-state)
%- ~(all by snd.peer-state)
|= =message-pump-state
=(~ live.packet-pump-state.message-pump-state)
==
now
::
=/ =message-blob (dedup-message (jim payload))
=. peer-core (run-message-pump bone %memo message-blob)
::
?: &(=(%boon valence) ?=(?(%dead %unborn) -.qos.peer-state))
?: ?& =(%boon valence)
(gte now (add ~s30 last-contact.qos.peer-state))
==
check-clog
peer-core
:: +dedup-message: replace with any existing copy of this message
@ -2535,7 +2527,7 @@
++ assert
^+ message-pump
=/ top-live
(peek:packet-queue:*make-packet-pump live.packet-pump-state.state)
(pry:packet-queue:*make-packet-pump live.packet-pump-state.state)
?. |(?=(~ top-live) (lte current.state message-num.key.u.top-live))
~| [%strange-current current=current.state key.u.top-live]
!!
@ -2603,7 +2595,7 @@
=| acc=(unit static-fragment)
^+ [static-fragment=acc live=live.state]
::
%^ (traverse:packet-queue _acc) live.state acc
%^ (dip:packet-queue _acc) live.state acc
|= $: acc=_acc
key=live-packet-key
val=live-packet-val
@ -2681,7 +2673,7 @@
=/ acc
resends=*(list static-fragment)
::
%^ (traverse:packet-queue _acc) live.state acc
%^ (dip:packet-queue _acc) live.state acc
|= $: acc=_acc
key=live-packet-key
val=live-packet-val
@ -2734,7 +2726,7 @@
::
^+ [acc live=live.state]
::
%^ (traverse:packet-queue _acc) live.state acc
%^ (dip:packet-queue _acc) live.state acc
|= $: acc=_acc
key=live-packet-key
val=live-packet-val
@ -2781,7 +2773,7 @@
::
^+ [metrics=metrics.state live=live.state]
::
%^ (traverse:packet-queue pump-metrics) live.state acc=metrics.state
%^ (dip:packet-queue pump-metrics) live.state acc=metrics.state
|= $: metrics=pump-metrics
key=live-packet-key
val=live-packet-val
@ -2804,10 +2796,10 @@
::
++ set-wake
^+ packet-pump
:: if nonempty .live, peek at head to get next wake time
:: if nonempty .live, pry at head to get next wake time
::
=/ new-wake=(unit @da)
?~ head=(peek:packet-queue live.state)
?~ head=(pry:packet-queue live.state)
~
`(next-expiry:gauge u.head)
:: no-op if no change

4
pkg/arvo/sys/vane/behn.hoon
View File

@ -186,7 +186,7 @@
=* timers timers.state
:: if no timers, cancel existing wakeup timer or no-op
::
=/ first=(unit [date=@da *]) (peek:timer-map timers.state)
=/ first=(unit [date=@da *]) (pry:timer-map timers.state)
?~ first
?~ next-wake
event-core
@ -351,7 +351,7 @@
[%timers %next ~]
:^ ~ ~ %noun
!> ^- (unit @da)
(bind (peek:timer-map timers) head)
(bind (pry:timer-map timers) head)
::
[%timers @ ~]
?~ til=(slaw %da i.t.tyl)

515
pkg/arvo/sys/vane/clay.hoon
View File

@ -59,6 +59,12 @@
::
+$ cult (jug wove duct)
::
:: State for ongoing %fuse merges. `con` maintains the ordering,
:: `sto` stores the data needed to merge, and `bas` is the base
:: beak for the merge.
::
+$ melt [bas=beak con=(list [beak germ]) sto=(map beak (unit dome:clay))]
::
:: Domestic desk state.
::
:: Includes subscriber list, dome (desk content), possible commit state (for
@ -69,6 +75,7 @@
dom=dome :: desk state
per=regs :: read perms per path
pew=regs :: write perms per path
fiz=melt :: state for mega merges
==
::
:: Desk state.
@ -118,11 +125,11 @@
:: Ford cache
::
+$ ford-cache
$: files=(map path [res=vase dez=(set path)])
naves=(map mark [res=vase dez=(set path)])
marks=(map mark [res=dais dez=(set path)])
casts=(map mars [res=vase dez=(set path)])
tubes=(map mars [res=tube dez=(set path)])
$: files=(map path [res=vase dez=(set [dir=? =path])])
naves=(map mark [res=vase dez=(set [dir=? =path])])
marks=(map mark [res=dais dez=(set [dir=? =path])])
casts=(map mars [res=vase dez=(set [dir=? =path])])
tubes=(map mars [res=tube dez=(set [dir=? =path])])
==
:: $reef-cache: built system files
::
@ -212,6 +219,7 @@
dom=dome :: revision state
per=regs :: read perms per path
pew=regs :: write perms per path
fiz=melt :: domestic mega merges
== ::
::
:: Foreign request manager.
@ -303,6 +311,7 @@
$: %c :: to %clay
$> $? %info :: internal edit
%merg :: merge desks
%fuse :: merge many
%pork ::
%warp ::
%werp ::
@ -430,18 +439,23 @@
::
++ an
|_ nak=ankh
:: +dug: produce ankh at path
::
++ dug
|= =path
^- (unit ankh)
?~ path `nak
?~ kid=(~(get by dir.nak) i.path)
~
$(nak u.kid, path t.path)
:: +get: produce file at path
::
++ get
|= =path
^- (unit cage)
?~ path
?~ fil.nak
~
`q.u.fil.nak
?~ kid=(~(get by dir.nak) i.path)
~
$(nak u.kid, path t.path)
?~ nik=(dug path) ~
?~ fil.u.nik ~
`q.u.fil.u.nik
--
++ with-face |=([face=@tas =vase] vase(p [%face face p.vase]))
++ with-faces
@ -474,7 +488,7 @@
+$ state
$: baked=(map path cage)
cache=ford-cache
stack=(list (set path))
stack=(list (set [dir=? =path]))
cycle=(set build)
==
+$ args
@ -495,8 +509,8 @@
:: +pop-stack: pop build stack, copying deps downward
::
++ pop-stack
^- [(set path) _stack.nub]
=^ top=(set path) stack.nub stack.nub
^- [(set [dir=? =path]) _stack.nub]
=^ top=(set [dir=? =path]) stack.nub stack.nub
=? stack.nub ?=(^ stack.nub)
stack.nub(i (~(uni in i.stack.nub) top))
[top stack.nub]
@ -561,7 +575,6 @@
=/ dif diff:deg
^- (nave typ dif)
|%
++ bunt +<.cor
++ diff
|= [old=typ new=typ]
^- dif
@ -583,7 +596,6 @@
=/ dif _*diff:grad:cor
^- (nave:clay typ dif)
|%
++ bunt +<.cor
++ diff |=([old=typ new=typ] (diff:~(grad cor old) new))
++ form form:grad:cor
++ join
@ -624,7 +636,6 @@
:_ nub
^- dais
|_ sam=vase
++ bunt (slap nav limb/%bunt)
++ diff
|= new=vase
(slam (slap nav limb/%diff) (slop sam new))
@ -651,7 +662,7 @@
|= diff=vase
(slam (slap nav limb/%pact) (slop sam diff))
++ vale
|= =noun
|: noun=q:(slap nav !,(*hoon *vale))
(slam (slap nav limb/%vale) noun/noun)
--
:: +build-cast: produce gate to convert mark .a to, statically typed
@ -807,9 +818,11 @@
=^ res=vase nub (run-pile pile)
res
::
++ build-file
|= =path
++ build-dependency
|= dep=(each [dir=path fil=path] path)
^- [vase state]
=/ =path
?:(?=(%| -.dep) p.dep fil.p.dep)
~| %error-building^path
?^ got=(~(get by files.cache.nub) path)
=? stack.nub ?=(^ stack.nub)
@ -818,7 +831,9 @@
?: (~(has in cycle.nub) file+path)
~|(cycle+file+path^stack.nub !!)
=. cycle.nub (~(put in cycle.nub) file+path)
=. stack.nub [(sy path ~) stack.nub]
=. stack.nub
=- [(sy - ~) stack.nub]
?:(?=(%| -.dep) dep [& dir.p.dep])
=^ cag=cage nub (read-file path)
?> =(%hoon p.cag)
=/ tex=tape (trip !<(@t q.cag))
@ -828,11 +843,42 @@
=. files.cache.nub (~(put by files.cache.nub) path [res top])
[res nub]
::
++ build-file
|= =path
(build-dependency |+path)
:: +build-directory: builds files in top level of a directory
::
:: this excludes files directly at /path/hoon,
:: instead only including files in the unix-style directory at /path,
:: such as /path/file/hoon, but not /path/more/file/hoon.
::
++ build-directory
|= =path
^- [(map @ta vase) state]
=/ fiz=(list @ta)
=/ nuk=(unit _ankh) (~(dug an ankh) path)
?~ nuk ~
%+ murn
~(tap by dir.u.nuk)
|= [nom=@ta nak=_ankh]
?. ?=([~ [~ *] *] (~(get by dir.nak) %hoon)) ~
`nom
::
=| rez=(map @ta vase)
|-
?~ fiz
[rez nub]
=* nom=@ta i.fiz
=/ pax=^path (weld path nom %hoon ~)
=^ res nub (build-dependency &+[path pax])
$(fiz t.fiz, rez (~(put by rez) nom res))
::
++ run-pile
|= =pile
=^ sut=vase nub (run-tauts bud %sur sur.pile)
=^ sut=vase nub (run-tauts sut %lib lib.pile)
=^ sut=vase nub (run-raw sut raw.pile)
=^ sut=vase nub (run-raz sut raz.pile)
=^ sut=vase nub (run-maz sut maz.pile)
=^ sut=vase nub (run-caz sut caz.pile)
=^ sut=vase nub (run-bar sut bar.pile)
@ -871,7 +917,10 @@
(most ;~(plug com gaw) taut-rule)
::
%+ rune tis
;~(plug sym ;~(pfix gap fas (more fas urs:ab)))
;~(plug sym ;~(pfix gap stap))
::
%+ rune sig
;~((glue gap) sym wyde:vast stap)
::
%+ rune cen
;~(plug sym ;~(pfix gap ;~(pfix cen sym)))
@ -887,7 +936,7 @@
;~ (glue gap)
sym
;~(pfix cen sym)
;~(pfix fas (more fas urs:ab))
;~(pfix stap)
==
::
%+ stag %tssg
@ -933,6 +982,30 @@
=. p.pin [%face face.i.raw p.pin]
$(sut (slop pin sut), raw t.raw)
::
++ run-raz
|= [sut=vase raz=(list [face=term =spec =path])]
^- [vase state]
?~ raz [sut nub]
=^ res=(map @ta vase) nub
(build-directory path.i.raz)
=; pin=vase
=. p.pin [%face face.i.raz p.pin]
$(sut (slop pin sut), raz t.raz)
::
=/ =type (~(play ut p.sut) [%kttr spec.i.raz])
:: ensure results nest in the specified type,
:: and produce a homogenous map containing that type.
::
:- %- ~(play ut p.sut)
[%kttr %make [%wing ~[%map]] ~[[%base %atom %ta] spec.i.raz]]
|-
?~ res ~
?. (~(nest ut type) | p.q.n.res)
~| [%nest-fail path.i.raz p.n.res]
!!
:- [p.n.res q.q.n.res]
[$(res l.res) $(res r.res)]
::
++ run-maz
|= [sut=vase maz=(list [face=term =mark])]
^- [vase state]
@ -1045,12 +1118,12 @@
~
=/ rus rus:(~(gut by hoy.ruf) her *rung)
%+ ~(gut by rus) syd
[lim=~2000.1.1 ref=`*rind qyx=~ dom=*dome per=~ pew=~]
[lim=~2000.1.1 ref=`*rind qyx=~ dom=*dome per=~ pew=~ fiz=*melt]
:: administrative duct, domestic +rede
::
:+ ~ `hun.rom.ruf
=/ jod (~(gut by dos.rom.ruf) syd *dojo)
[lim=now ref=~ [qyx dom per pew]:jod]
[lim=now ref=~ [qyx dom per pew fiz]:jod]
::
=* red=rede ->+
|%
@ -1067,7 +1140,7 @@
::
%= ruf
hun.rom (need hun)
dos.rom (~(put by dos.rom.ruf) syd [qyx dom per pew]:red)
dos.rom (~(put by dos.rom.ruf) syd [qyx dom per pew fiz]:red)
==
::
:: Handle `%sing` requests
@ -1258,6 +1331,24 @@
=/ =path [%question desk (scot %ud index) ~]
(emit duct %pass wire %a %plea ship %c path `riff-any`[%1 riff])
::
++ foreign-capable
|= =rave
|^
?- -.rave
%many &
%sing (good-care care.mood.rave)
%next (good-care care.mood.rave)
%mult
%- ~(all in paths.mool.rave)
|= [=care =path]
(good-care care)
==
::
++ good-care
|= =care
(~(has in ^~((silt `(list ^care)`~[%u %w %x %y %z]))) care)
--
::
:: Create a request that cannot be filled immediately.
::
:: If it's a local request, we just put in in `qyx`, setting a timer if it's
@ -1277,6 +1368,10 @@
=. rave
?. ?=([%sing %v *] rave) rave
[%many %| [%ud let.dom] case.mood.rave path.mood.rave]
::
?. (foreign-capable rave)
~|([%clay-bad-foreign-request-care rave] !!)
::
=+ inx=nix.u.ref
=. +>+.$
=< ?>(?=(^ ref) .)
@ -1584,12 +1679,19 @@
::
++ invalidate
|* [key=mold value=mold]
|= [cache=(map key [value dez=(set path)]) invalid=(set path)]
=/ builds=(list [key value dez=(set path)]) ~(tap by cache)
|= [cache=(map key [value dez=(set [dir=? =path])]) invalid=(set path)]
=/ builds=(list [key value dez=(set [dir=? =path])])
~(tap by cache)
|- ^+ cache
?~ builds
~
?: ?=(^ (~(int in dez.i.builds) invalid))
?: %- ~(any in dez.i.builds)
|= [dir=? =path]
?. dir (~(has in invalid) path)
=+ l=(lent path)
%- ~(any in invalid)
|= i=^path
&(=(path (scag l i)) ?=([@ %hoon ~] (slag l i)))
$(builds t.builds)
(~(put by $(builds t.builds)) i.builds)
::
@ -1965,32 +2067,178 @@
=/ =wire /merge/[syd]/(scot %p ali-ship)/[ali-desk]/[germ]
(emit hen %pass wire %c %warp ali-ship ali-desk `[%sing %v case /])
::
++ make-melt
|= [bas=beak con=(list [beak germ])]
^- melt
:+ bas con
%- ~(gas by *(map beak (unit dome:clay)))
:- [bas *(unit dome:clay)]
(turn con |=(a=[beak germ] [-.a *(unit dome:clay)]))
::
++ start-fuse
|= [bas=beak con=(list [beak germ])]
^+ ..start-fuse
=/ moves=(list move)
%+ turn
[[bas *germ] con]
|= [bec=beak germ]
^- move
=/ wir=wire /fuse/[syd]/(scot %p p.bec)/[q.bec]/(scot r.bec)
[hen %pass wir %c %warp p.bec q.bec `[%sing %v r.bec /]]
::
:: We also want to clear the state (fiz) associated with this
:: merge and print a warning if it's non trivial i.e. we're
:: starting a new fuse before the previous one terminated.
::
=/ err=tang
?~ con.fiz
~
=/ discarded=tang
%+ turn
~(tap in sto.fiz)
|= [k=beak v=(unit dome:clay)]
^- tank
=/ received=tape ?~(v "missing" "received")
leaf+"{<k>} {received}"
:_ discarded
leaf+"fusing into {<syd>} from {<bas>} {<con>} - overwriting prior fuse"
=. fiz (make-melt bas con)
((slog err) (emil moves))
::
++ take-fuse
|^
::
|= [bec=beak =riot]
^+ ..take-fuse
?~ riot
::
:: By setting fiz to *melt the merge is aborted - any further
:: responses we get for the merge will cause take-fuse to crash
::
=. fiz *melt
((slog [leaf+"clay: fuse failed, missing {<bec>}"]~) ..take-fuse)
?> (~(has by sto.fiz) bec)
=. fiz
:+ bas.fiz con.fiz
(~(put by sto.fiz) bec `!<(dome:clay q.r.u.riot))
=/ all-done=flag
%- ~(all by sto.fiz)
|= res=(unit dome:clay)
^- flag
!=(res ~)
?. all-done
..take-fuse
=| rag=rang
=/ clean-state ..take-fuse
=/ initial-dome=dome:clay (need (~(got by sto.fiz) bas.fiz))
=/ continuation-yaki=yaki
(~(got by hut.ran) (~(got by hit.initial-dome) let.initial-dome))
=/ parents=(list tako) ~[(~(got by hit.initial-dome) let.initial-dome)]
=/ merges con.fiz
|-
^+ ..take-fuse
?~ merges
=/ t=tang [leaf+"{<syd>} fused from {<bas.fiz>} {<con.fiz>}" ~]
=. ..take-fuse (done-fuse clean-state %& ~)
(park | [%| continuation-yaki(p (flop parents))] rag)
=/ [bec=beak g=germ] i.merges
=/ ali-dom=dome:clay (need (~(got by sto.fiz) bec))
=/ result (merge-helper p.bec q.bec g ali-dom `continuation-yaki)
?- -.result
%|
(done-fuse clean-state %| %fuse-merge-failed p.result)
::
%&
=/ merge-result=(unit merge-result) +.result
?~ merge-result
::
:: This merge was a no-op, just continue
::
$(merges t.merges)
?^ conflicts.u.merge-result
::
:: If there are merge conflicts send the error and abort the merge
::
(done-fuse clean-state %& conflicts.u.merge-result)
=/ merged-yaki=yaki
?- -.new.u.merge-result
%|
+.new.u.merge-result
::
%&
::
:: Convert the yuki to yaki
::
=/ yuk=yuki +.new.u.merge-result
=/ lobes=(map path lobe)
%- ~(run by q.yuk)
|= val=(each page lobe)
^- lobe
?- -.val
%& (page-to-lobe +.val)
%| +.val
==
(make-yaki p.yuk lobes now)
==
%= $
continuation-yaki merged-yaki
merges t.merges
hut.ran (~(put by hut.ran) r.merged-yaki merged-yaki)
lat.rag (~(uni by lat.rag) lat.u.merge-result)
parents [(~(got by hit.ali-dom) let.ali-dom) parents]
==
==
:: +done-fuse: restore state after a fuse is attempted, whether it
:: succeeds or fails.
::
++ done-fuse
|= [to-restore=_..take-fuse result=(each (set path) (pair term tang))]
^+ ..take-fuse
=. fiz.to-restore *melt
(done:to-restore result)
--
::
++ done
|= result=(each (set path) (pair term tang))
^+ ..merge
(emit hen %give %mere result)
::
++ merge
|= [=ali=ship =ali=desk =germ =riot]
^+ ..merge
|^
?~ riot
(done %| %ali-unavailable >[ali-ship ali-desk germ]< ~)
(done %| %ali-unavailable ~[>[ali-ship ali-desk germ]<])
=/ ali-dome=dome:clay !<(dome:clay q.r.u.riot)
=/ result=(each (unit merge-result) (pair term tang))
(merge-helper ali-ship ali-desk germ ali-dome ~)
?- -.result
%|
(done %| +.result)
::
%&
=/ mr=(unit merge-result) +.result
?~ mr
(done %& ~)
=. ..merge (done %& conflicts.u.mr)
(park | new.u.mr ~ lat.u.mr)
==
::
+$ merge-result [conflicts=(set path) new=yoki lat=(map lobe blob)]
::
++ merge-helper
|= [=ali=ship =ali=desk =germ ali-dome=dome:clay continuation-yaki=(unit yaki)]
^- (each (unit merge-result) [term tang])
|^
^- (each (unit merge-result) [term tang])
=/ ali-yaki=yaki (~(got by hut.ran) (~(got by hit.ali-dome) let.ali-dome))
=/ bob-yaki=(unit yaki)
?~ let.dom
~
(~(get by hut.ran) (~(got by hit.dom) let.dom))
=/ merge-result (merge-by-germ ali-yaki bob-yaki)
?: ?=(%| -.merge-result)
(done %| p.merge-result)
?~ p.merge-result
(done %& ~)
=. ..merge (done %& conflicts.u.p.merge-result)
(park | new.u.p.merge-result ~ lat.u.p.merge-result)
?~ continuation-yaki
?~ let.dom
~
(~(get by hut.ran) (~(got by hit.dom) let.dom))
continuation-yaki
(merge-by-germ ali-yaki bob-yaki)
::
++ done
|= result=(each (set path) (pair term tang))
^+ ..merge
(emit hen %give %mere result)
::
+$ merge-result [conflicts=(set path) new=yoki lat=(map lobe blob)]
++ merge-by-germ
|= [=ali=yaki bob-yaki=(unit yaki)]
^- (each (unit merge-result) [term tang])
@ -2008,16 +2256,13 @@
?- germ
::
:: If this is a %only-this merge, we check to see if ali's and bob's
:: commits are the same, in which case we're done. Otherwise, we
:: check to see if ali's commit is in the ancestry of bob's, in
:: which case we're done. Otherwise, we create a new commit with
:: bob's data plus ali and bob as parents.
:: commits are the same, in which case we're done.
:: Otherwise, we create a new commit with bob's data plus ali and
:: bob as parents.
::
%only-this
?: =(r.ali-yaki r.bob-yaki)
&+~
?: (~(has in (reachable-takos:ze r.bob-yaki)) r.ali-yaki)
&+~
:* %& ~
conflicts=~
new=&+[[r.bob-yaki r.ali-yaki ~] (to-yuki q.bob-yaki)]
@ -2045,8 +2290,6 @@
%take-this
?: =(r.ali-yaki r.bob-yaki)
&+~
?: (~(has in (reachable-takos:ze r.bob-yaki)) r.ali-yaki)
&+~
=/ new-data (~(uni by q.ali-yaki) q.bob-yaki)
:* %& ~
conflicts=~
@ -2316,7 +2559,7 @@
=+ (slag (dec (lent path)) path)
?~(- %$ i.-)
=/ =dais (get-dais mark)
=/ res=(unit (unit vase)) (~(join dais bunt:dais) q.cal q.cob)
=/ res=(unit (unit vase)) (~(join dais *vale:dais) q.cal q.cob)
?~ res
`[form:dais q.cob]
?~ u.res
@ -2668,6 +2911,9 @@
++ start-request
|= [for=(unit [ship @ud]) rav=rave]
^+ ..start-request
?: &(?=(^ for) !(foreign-capable rav))
~& [%bad-foreign-request-care from=for rav]
..start-request
=^ [new-sub=(unit rove) sub-results=(list sub-result)] fod.dom
(try-fill-sub for (rave-to-rove rav))
=. ..start-request (send-sub-results sub-results [hen ~ ~])
@ -2724,14 +2970,23 @@
%r ~| %no-cages-please-they-are-just-way-too-big !!
%s ~| %please-dont-get-your-takos-over-a-network !!
%t ~| %requesting-foreign-directory-is-vaporware !!
%u ~| %prolly-poor-idea-to-get-rang-over-network !!
%v ~| %weird-shouldnt-get-v-request-from-network !!
%z `(validate-z r.rand)
%u `(validate-u r.rand)
%w `(validate-w r.rand)
%x (validate-x [p.p q.p q r]:rand)
%y `[p.r.rand !>(;;(arch q.r.rand))]
%z `(validate-z r.rand)
==
::
:: Make sure the incoming data is a %u response
::
++ validate-u
|= =page
^- cage
?> ?=(%flag p.page)
:- p.page
!> ;;(? q.page)
::
:: Make sure the incoming data is a %w response
::
++ validate-w
@ -2752,7 +3007,11 @@
=/ vale-result
%- mule |.
%- wrap:fusion
(page-to-cage:(ford:fusion static-ford-args) peg)
:: Use %home's marks to validate, so we don't have to build the
:: foreign hoon/zuse
::
=/ args %*(static-ford-args . dom dom:(~(got by dos.rom) %home))
(page-to-cage:(ford:fusion args) peg)
?: ?=(%| -.vale-result)
%- (slog >%validate-x-failed< p.vale-result)
~
@ -2765,7 +3024,7 @@
^- cage
?> ?=(%uvi p.page)
:- p.page
!>(;;(@uvI q.page))
!> ;;(@uvI q.page)
--
::
:: Respond to backfill request
@ -3394,12 +3653,29 @@
|-
?: =(b let.dom)
hit.dom
:: del everything after b
$(hit.dom (~(del by hit.dom) let.dom), let.dom (dec let.dom))
b
?: =(0 b)
[~ ~]
(data-twixt-takos =(0 ver) (~(get by hit.dom) a) (aeon-to-tako b))
::
=/ excludes=(set tako)
=| acc=(set tako)
=/ lower=@ud 1
|-
:: a should be excluded, so wait until we're past it
?: (gte lower +(a))
acc
=/ res=(set tako) (reachable-takos (~(got by hit.dom) lower))
$(acc (~(uni in acc) res), lower +(lower))
=/ includes=(set tako)
=| acc=(set tako)
=/ upper=@ud b
|-
?: (lte upper a)
acc
=/ res=(set tako) (reachable-takos (~(got by hit.dom) upper))
$(acc (~(uni in acc) res), upper (dec upper))
[(~(run in (~(dif in includes) excludes)) tako-to-yaki) ~]
:: Traverse parentage and find all ancestor hashes
::
++ reachable-takos :: reachable
@ -3418,30 +3694,6 @@
=. s ^$(p i.p.y)
$(p.y t.p.y)
::
:: Gets the data between two commit hashes, assuming the first is an
:: ancestor of the second.
::
:: Get all the takos before `a`, then get all takos before `b` except the
:: ones we found before `a`. Then convert the takos to yakis and also get
:: all the data in all the yakis.
::
:: What happens if you run an %init merge on a desk that already
:: had a commit?
::
++ data-twixt-takos
|= [plops=? a=(unit tako) b=tako]
^- [(set yaki) (set plop)]
=+ old=?~(a ~ (reachable-takos u.a))
=/ yal=(set tako)
%- silt
%+ skip
~(tap in (reachable-takos b))
|=(tak=tako (~(has in old) tak))
:- (silt (turn ~(tap in yal) tako-to-yaki))
?. plops
~
(silt (turn ~(tap in (new-lobes (new-lobes ~ old) yal)) lobe-to-blob))
::
:: Get all the lobes that are referenced in `a` except those that are
:: already in `b`.
::
@ -3531,11 +3783,11 @@
[[~ ~] fod.dom]
=/ cached=(unit [=vase *]) (~(get by naves.fod.dom) i.path)
?^ cached
:_(fod.dom [~ ~ %& %nave !>(vase.u.cached)])
:_(fod.dom [~ ~ %& %nave vase.u.cached])
=^ =vase fod.dom
%- wrap:fusion
(build-nave:(ford:fusion static-ford-args) i.path)
:_(fod.dom [~ ~ %& %nave !>(vase)])
:_(fod.dom [~ ~ %& %nave vase])
::
++ read-f
!.
@ -3961,12 +4213,14 @@
::
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
=| :: instrument state
$: ver=%7 :: vane version
$: ver=%8 :: vane version
ruf=raft :: revision tree
== ::
|= [now=@da eny=@uvJ rof=roof] :: current invocation
~% %clay-top ..part ~
|% ::
++ call :: handle request
~/ %clay-call
|= $: hen=duct
dud=(unit goof)
wrapped-task=(hobo task)
@ -4077,6 +4331,14 @@
=/ den ((de now rof hen ruf) our des.req)
abet:(start-merge:den her.req dem.req cas.req how.req)
[mos ..^$]
::
%fuse
?: =(%$ des.req)
~&(%fuse-no-desk !!)
=^ mos ruf
=/ den ((de now rof hen ruf) our des.req)
abet:(start-fuse:den bas.req con.req)
[mos ..^$]
::
%mont
=. hez.ruf ?^(hez.ruf hez.ruf `[[%$ %sync ~] ~])
@ -4205,11 +4467,41 @@
++ load
=> |%
+$ raft-any
$% [%7 raft-7]
$% [%8 raft-8]
[%7 raft-7]
[%6 raft-6]
==
+$ raft-7 raft
+$ dojo-7 dojo
+$ raft-8 raft
+$ raft-7
$: rom=room-7
hoy=(map ship rung-7)
ran=rang
mon=(map term beam)
hez=(unit duct)
cez=(map @ta crew)
pud=(unit [=desk =yoki])
==
+$ room-7
$: hun=duct
dos=(map desk dojo-7)
==
+$ rung-7
$: rus=(map desk rede-7)
==
+$ dojo-7
$: qyx=cult
dom=dome
per=regs
pew=regs
==
+$ rede-7
$: lim=@da
ref=(unit rind)
qyx=cult
dom=dome
per=regs
pew=regs
==
+$ ford-cache-7 ford-cache
+$ raft-6
$: rom=room-6 :: domestic
@ -4252,7 +4544,8 @@
|= old=raft-any
|^
=? old ?=(%6 -.old) 7+(raft-6-to-7 +.old)
?> ?=(%7 -.old)
=? old ?=(%7 -.old) 8+(raft-7-to-8 +.old)
?> ?=(%8 -.old)
..^^$(ruf +.old)
:: +raft-6-to-7: delete stale ford caches (they could all be invalid)
::
@ -4273,9 +4566,30 @@
|= =rede-6
rede-6(dom dom.rede-6(fod *ford-cache-7))
==
:: +raft-7-to-8: create bunted melts in each dojo/rede
::
++ raft-7-to-8
|= raf=raft-7
^- raft-8
%= raf
dos.rom
%- ~(run by dos.rom.raf)
|= doj=dojo-7
^- dojo
[qyx.doj dom.doj per.doj pew.doj *melt]
::
hoy
%- ~(run by hoy.raf)
|= =rung-7
%- ~(run by rus.rung-7)
|= r=rede-7
^- rede
[lim.r ref.r qyx.r dom.r per.r pew.r *melt]
==
--
::
++ scry :: inspect
~/ %clay-scry
^- roon
|= [lyc=gang car=term bem=beam]
^- (unit (unit cage))
@ -4337,6 +4651,7 @@
==
::
++ take :: accept response
~/ %clay-take
|= [tea=wire hen=duct dud=(unit goof) hin=sign]
^+ [*(list move) ..^$]
?^ dud
@ -4353,6 +4668,18 @@
abet:(merge:den ali-ship ali-desk germ p.hin)
[mos ..^$]
::
?: ?=([%fuse @ @ @ @ ~] tea)
?> ?=(%writ +<.hin)
=* syd i.t.tea
=/ ali-ship=@p (slav %p i.t.t.tea)
=* ali-desk=desk i.t.t.t.tea
=/ ali-case (rash i.t.t.t.t.tea nuck:so)
?> ?=([%$ *] ali-case)
=^ mos ruf
=/ den ((de now rof hen ruf) our i.t.tea)
abet:(take-fuse:den [ali-ship ali-desk (case +.ali-case)] p.hin)
[mos ..^$]
::
?: ?=([%foreign-warp *] tea)
?> ?=(%writ +<.hin)
:_ ..^$

88
pkg/arvo/sys/vane/eyre.hoon
View File

@ -30,6 +30,9 @@
$% [%rest p=@da]
[%wait p=@da]
== ==
$: %c
$>(%warp task:clay)
==
:: %d: to dill
::
$: %d
@ -53,6 +56,12 @@
$: %gall
gift:gall
:: $>(%unto gift:gall)
::
==
$: %clay
gift:clay
:: $>(%writ gift:clay)
::
== ==
--
:: more structures
@ -215,7 +224,7 @@
?: =('subscribe' u.maybe-key)
%. item
%+ pe %subscribe
(ot id+ni ship+(su fed:ag) app+so path+(su ;~(pfix fas (more fas urs:ab))) ~)
(ot id+ni ship+(su fed:ag) app+so path+(su stap) ~)
?: =('unsubscribe' u.maybe-key)
%. item
%+ pe %unsubscribe
@ -426,10 +435,12 @@
:- ~
%- as-octs:mimes:html
%- crip
%- zing
%- zing ^- ^wall
%- zing ^- (list ^wall)
%+ turn wall
|= t=tape
"{t}\0a"
^- ^wall
~[t "\0a"]
:: +internal-server-error: 500 page, with a tang
::
++ internal-server-error
@ -1229,9 +1240,9 @@
::NOTE these will only fail if the mark and/or json types changed,
:: since conversion failure also gets caught during first receive.
:: we can't do anything about this, so consider it unsupported.
?~ sign=(channel-event-to-sign channel-event) $
?~ json=(sign-to-json request-id u.sign) $
$(events [(event-json-to-wall id u.json) events])
?~ sign=(channel-event-to-sign channel-event) $
?~ jive=(sign-to-json request-id u.sign) $
$(events [(event-json-to-wall id +.u.jive) events])
:: send the start event to the client
::
=^ http-moves state
@ -1497,8 +1508,12 @@
:: if conversion succeeds, we *can* send it. if the client is actually
:: connected, we *will* send it immediately.
::
=/ json=(unit json)
=/ jive=(unit (quip move json))
(sign-to-json request-id sign)
=/ json=(unit json)
?~(jive ~ `+.u.jive)
=? moves ?=(^ jive)
(weld moves -.u.jive)
=* sending &(?=([%| *] state.u.channel) ?=(^ json))
::
=/ next-id next-id.u.channel
@ -1576,7 +1591,7 @@
^= data
%- wall-to-octs
%+ event-json-to-wall next-id
(need (sign-to-json request-id %kick ~))
+:(need (sign-to-json request-id %kick ~))
::
complete=%.n
==
@ -1598,6 +1613,7 @@
:: +channel-event-to-sign: attempt to recover a sign from a channel-event
::
++ channel-event-to-sign
~% %eyre-channel-event-to-sign ..part ~
|= event=channel-event
^- (unit sign:agent:gall)
?. ?=(%fact -.event) `event
@ -1616,32 +1632,33 @@
:: +sign-to-json: render sign from request-id as json channel event
::
++ sign-to-json
~% %sign-to-json ..part ~
|= [request-id=@ud =sign:agent:gall]
^- (unit json)
^- (unit (quip move json))
:: for facts, we try to convert the result to json
::
=/ jsyn=(unit sign:agent:gall)
?. ?=(%fact -.sign) `sign
?: ?=(%json p.cage.sign) `sign
=/ [from=(unit mark) jsyn=(unit sign:agent:gall)]
?. ?=(%fact -.sign) [~ `sign]
?: ?=(%json p.cage.sign) [~ `sign]
:: find and use tube from fact mark to json
::
=* have=mark p.cage.sign
=* desc=tape "from {(trip have)} to json"
=/ tube=(unit tube:clay)
=/ tuc=(unit (unit cage))
(rof ~ %cc [our %home da+now] /[have]/json)
?. ?=([~ ~ *] tuc) ~
`!<(tube:clay q.u.u.tuc)
?~ tube
((slog leaf+"eyre: no tube {desc}" ~) ~)
::
=/ res (mule |.((u.tube q.cage.sign)))
?: ?=(%& -.res)
`[%fact %json p.res]
((slog leaf+"eyre: failed tube {desc}" ~) ~)
::
=/ convert=(unit vase)
=/ cag=(unit (unit cage))
(rof ~ %cf [our %home da+now] /[have]/json)
?. ?=([~ ~ *] cag) ~
`q.u.u.cag
?~ convert
((slog leaf+"eyre: no convert {desc}" ~) [~ ~])
~| "conversion failed {desc}"
[`have `[%fact %json (slym u.convert q.q.cage.sign)]]
?~ jsyn ~
%- some
:- ?~ from ~
:_ ~
:^ duct %pass /conversion-cache/[u.from]
[%c %warp our %home `[%sing %f da+now /[u.from]/json]]
=* sign u.jsyn
=, enjs:format
%- pairs
@ -1662,7 +1679,7 @@
:- 'json'
~| [%unexpected-fact-mark p.cage.sign]
?> =(%json p.cage.sign)
;;(json q.q.cage.sign)
!<(json q.cage.sign)
==
::
%kick
@ -1678,6 +1695,7 @@
==
::
++ event-json-to-wall
~% %eyre-json-to-wall ..part ~
|= [event-id=@ud =json]
^- wall
:~ (weld "id: " (format-ud-as-integer event-id))
@ -2095,6 +2113,7 @@
~% %http-server ..part ~
|%
++ call
~/ %eyre-call
|= [=duct dud=(unit goof) wrapped-task=(hobo task)]
^- [(list move) _http-server-gate]
::
@ -2297,6 +2316,7 @@
==
::
++ take
~/ %eyre-take
|= [=wire =duct dud=(unit goof) =sign]
^- [(list move) _http-server-gate]
?^ dud
@ -2314,14 +2334,15 @@
::
|^ ^- [(list move) _http-server-gate]
::
?+ i.wire
~|([%bad-take-wire wire] !!)
?+ i.wire
~|([%bad-take-wire wire] !!)
::
%run-app-request run-app-request
%watch-response watch-response
%sessions sessions
%channel channel
%acme acme-ack
%run-app-request run-app-request
%watch-response watch-response
%sessions sessions
%channel channel
%acme acme-ack
%conversion-cache `http-server-gate
==
::
++ run-app-request
@ -2484,6 +2505,7 @@
:: +scry: request a path in the urbit namespace
::
++ scry
~/ %eyre-scry
^- roon
|= [lyc=gang car=term bem=beam]
^- (unit (unit cage))

6
pkg/arvo/sys/vane/gall.hoon
View File

@ -159,7 +159,10 @@
~< %slog.[0 leaf+"gall: molted"]
:: +molt should never notify its client about agent changes
::
=- [(skip -< |=(move ?=([* %pass [%sys %say ~] *] +<))) ->]
=- :_ ->
%+ welp
(skip -< |=(move ?=([* %give %onto *] +<)))
[^duct %pass /whiz/gall %$ %whiz ~]~
=/ adult adult-core
=. state.adult
[%7 system-duct outstanding contacts yokes=~ blocked]:spore
@ -656,6 +659,7 @@
:: cleared queue in +load 3-to-4 or +load-4-to-5
::
=? stand ?=(~ stand)
~& [%gall-missing wire hen]
(~(put to *(qeu remote-request)) %missing)
~| [full-wire=full-wire hen=hen stand=stand]
=^ rr stand ~(get to stand)

385
pkg/arvo/sys/zuse.hoon
View File

@ -3286,7 +3286,7 @@
++ ship :: string from ship
|= a=^ship
^- json
(tape (slag 1 (scow %p a)))
[%n (rap 3 '"' (rsh [3 1] (scot %p a)) '"' ~)]
:: :: ++numb:enjs:format
++ numb :: number from unsigned
|= a=@u
@ -3391,6 +3391,11 @@
:: :: ++no:dejs:format
++ no :: number as cord
|=(jon=json ?>(?=([%n *] jon) p.jon))
:: :: ++nu:dejs:format
++ nu :: parse number as hex
|= jon=json
?> ?=([%s *] jon)
(rash p.jon hex)
:: :: ++of:dejs:format
++ of :: object as frond
|* wer=(pole [cord fist])
@ -3440,6 +3445,11 @@
=/ ten ~|(key+key.wer (wit.wer (~(get by jom) key.wer)))
?~(t.wer ten [ten ((ou-raw t.wer) jom)])
==
:: :: ++oj:dejs:format
++ oj :: object as jug
|* =fist
^- $-(json (jug cord _(fist *json)))
(om (as fist))
:: :: ++om:dejs:format
++ om :: object as map
|* wit=fist
@ -3458,7 +3468,7 @@
[(rash a fel) b]
:: :: ++pa:dejs:format
++ pa :: string as path
(su ;~(pfix fas (more fas urs:ab)))
(su stap)
:: :: ++pe:dejs:format
++ pe :: prefix
|* [pre=* wit=fist]
@ -3466,6 +3476,12 @@
:: :: ++sa:dejs:format
++ sa :: string as tape
|=(jon=json ?>(?=([%s *] jon) (trip p.jon)))
:: :: ++sd:dejs:format
++ sd :: string @ud as date
|= jon=json
^- @da
?> ?=(%s -.jon)
`@da`(rash p.jon dem:ag)
:: :: ++se:dejs:format
++ se :: string as aura
|= aur=@tas
@ -3580,6 +3596,15 @@
?. ?=([%s *] jon) ~
(bind (stud:chrono:userlib p.jon) |=(a=date (year a)))
::
++ dank :: tank
^- $-(json (unit tank))
%+ 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) ~)
==
::
++ di :: millisecond date
(cu from-unix-ms:chrono:userlib ni)
::
@ -3653,6 +3678,12 @@
|* [pre=* wit=fist]
(cu |*(* [pre +<]) wit)
::
++ re :: recursive reparsers
|* [gar=* sef=_|.(fist)]
|= jon=json
^- (unit _gar)
((sef) jon)
::
++ sa :: string as tape
|= jon=json
?.(?=([%s *] jon) ~ (some (trip p.jon)))
@ -5171,36 +5202,54 @@
|= ord=$-([key key] ?)
|= a=*
=/ b ;;((tree [key=key val=value]) a)
?> (check-balance:((ordered-map key value) ord) b)
?> (apt:((on key value) ord) b)
b
::
:: $mk-item: constructor for +ordered-map item type
::
++ mk-item |$ [key val] [key=key val=val]
:: +ordered-map: treap with user-specified horizontal order
::
:: Conceptually smaller items go on the left, so the item with the
:: smallest key can be popped off the head. If $key is `@` and
:: .compare is +lte, then the numerically smallest item is the head.
++ ordered-map on
:: +on: treap with user-specified horizontal order, ordered-map
::
:: WARNING: ordered-map will not work properly if two keys can be
:: unequal under noun equality but equal via the compare gate
::
++ ordered-map
++ on
~/ %on
|* [key=mold val=mold]
=> |%
+$ item (mk-item key val)
+$ item [key=key val=val]
--
:: +compare: item comparator for horizontal order
::
~% %comp +>+ ~
|= compare=$-([key key] ?)
~% %core + ~
|%
:: +check-balance: verify horizontal and vertical orderings
:: +all: apply logical AND boolean test on all values
::
++ check-balance
=| [l=(unit key) r=(unit key)]
|= a=(tree item)
++ all
~/ %all
|= [a=(tree item) b=$-(item ?)]
^- ?
|-
?~ a
&
?&((b n.a) $(a l.a) $(a r.a))
:: +any: apply logical OR boolean test on all values
::
++ any
~/ %any
|= [a=(tree item) b=$-(item ?)]
|- ^- ?
?~ a
|
?|((b n.a) $(a l.a) $(a r.a))
:: +apt: verify horizontal and vertical orderings
::
++ apt
~/ %apt
|= a=(tree item)
=| [l=(unit key) r=(unit key)]
|- ^- ?
:: empty tree is valid
::
?~ a %.y
@ -5223,64 +5272,22 @@
::
?~(r.a %.y &((mor key.n.a key.n.r.a) $(a r.a, r `key.n.a)))
==
:: +put: ordered item insert
:: +bap: convert to list, right to left
::
++ put
|= [a=(tree item) =key =val]
^- (tree item)
:: base case: replace null with single-item tree
::
?~ a [n=[key val] l=~ r=~]
:: base case: overwrite existing .key with new .val
::
?: =(key.n.a key) a(val.n val)
:: if item goes on left, recurse left then rebalance vertical order
::
?: (compare key key.n.a)
=/ l $(a l.a)
?> ?=(^ l)
?: (mor key.n.a key.n.l)
a(l l)
l(r a(l r.l))
:: item goes on right; recurse right then rebalance vertical order
::
=/ r $(a r.a)
?> ?=(^ r)
?: (mor key.n.a key.n.r)
a(r r)
r(l a(r l.r))
:: +peek: produce head (smallest item) or null
::
++ peek
++ bap
~/ %bap
|= a=(tree item)
^- (unit item)
::
?~ a ~
?~ l.a `n.a
$(a l.a)
::
:: +pop: produce .head (smallest item) and .rest or crash if empty
::
++ pop
|= a=(tree item)
^- [head=item rest=(tree item)]
::
?~ a !!
?~ l.a [n.a r.a]
::
=/ l $(a l.a)
:- head.l
:: load .rest.l back into .a and rebalance
::
?: |(?=(~ rest.l) (mor key.n.a key.n.rest.l))
a(l rest.l)
rest.l(r a(r r.rest.l))
^- (list item)
=| b=(list item)
|- ^+ b
?~ a b
$(a r.a, b [n.a $(a l.a)])
:: +del: delete .key from .a if it exists, producing value iff deleted
::
++ del
~/ %del
|= [a=(tree item) =key]
^- [(unit val) (tree item)]
::
?~ a [~ ~]
:: we found .key at the root; delete and rebalance
::
@ -5293,30 +5300,15 @@
[found a(l lef)]
=+ [found rig]=$(a r.a)
[found a(r rig)]
:: +nip: remove root; for internal use
::
++ nip
|= a=(tree item)
^- (tree item)
::
?> ?=(^ a)
:: delete .n.a; merge and balance .l.a and .r.a
::
|- ^- (tree item)
?~ l.a r.a
?~ r.a l.a
?: (mor key.n.l.a key.n.r.a)
l.a(r $(l.a r.l.a))
r.a(l $(r.a l.r.a))
:: +traverse: stateful partial inorder traversal
:: +dip: stateful partial inorder traversal
::
:: Mutates .state on each run of .f. Starts at .start key, or if
:: .start is ~, starts at the head (item with smallest key). Stops
:: when .f produces .stop=%.y. Traverses from smaller to larger
:: keys. Each run of .f can replace an item's value or delete the
:: item.
:: .start is ~, starts at the head. Stops when .f produces .stop=%.y.
:: Traverses from left to right keys.
:: Each run of .f can replace an item's value or delete the item.
::
++ traverse
++ dip
~/ %dip
|* state=mold
|= $: a=(tree item)
=state
@ -5375,63 +5367,18 @@
=/ rig main(a r.a)
rig(a a(r a.rig))
--
:: +tap: convert to list, smallest to largest
::
++ tap
|= a=(tree item)
^- (list item)
::
=| b=(list item)
|- ^+ b
?~ a b
::
$(a l.a, b [n.a $(a r.a)])
:: +bap: convert to list, largest to smallest
::
++ bap
|= a=(tree item)
^- (list item)
::
=| b=(list item)
|- ^+ b
?~ a b
::
$(a r.a, b [n.a $(a l.a)])
:: +gas: put a list of items
::
++ gas
~/ %gas
|= [a=(tree item) b=(list item)]
^- (tree item)
::
?~ b a
$(b t.b, a (put a i.b))
:: +uni: unify two ordered maps
::
:: .b takes precedence over .a if keys overlap.
::
++ uni
|= [a=(tree item) b=(tree item)]
^- (tree item)
::
?~ b a
?~ a b
?: =(key.n.a key.n.b)
::
[n=n.b l=$(a l.a, b l.b) r=$(a r.a, b r.b)]
::
?: (mor key.n.a key.n.b)
::
?: (compare key.n.b key.n.a)
$(l.a $(a l.a, r.b ~), b r.b)
$(r.a $(a r.a, l.b ~), b l.b)
::
?: (compare key.n.a key.n.b)
$(l.b $(b l.b, r.a ~), a r.a)
$(r.b $(b r.b, l.a ~), a l.a)
::
:: +get: get val at key or return ~
::
++ get
~/ %get
|= [a=(tree item) b=key]
^- (unit val)
?~ a ~
@ -5440,11 +5387,24 @@
?: (compare b key.n.a)
$(a l.a)
$(a r.a)
:: +got: need value at key
::
:: +subset: take a range excluding start and/or end and all elements
++ got
|= [a=(tree item) b=key]
^- val
(need (get a b))
:: +has: check for key existence
::
++ has
~/ %has
|= [a=(tree item) b=key]
^- ?
!=(~ (get a b))
:: +lot: take a subset range excluding start and/or end and all elements
:: outside the range
::
++ subset
++ lot
~/ %lot
|= $: tre=(tree item)
start=(unit key)
end=(unit key)
@ -5490,6 +5450,154 @@
$(a (nip a(r ~)))
==
--
:: +nip: remove root; for internal use
::
++ nip
~/ %nip
|= a=(tree item)
^- (tree item)
?> ?=(^ a)
:: delete .n.a; merge and balance .l.a and .r.a
::
|- ^- (tree item)
?~ l.a r.a
?~ r.a l.a
?: (mor key.n.l.a key.n.r.a)
l.a(r $(l.a r.l.a))
r.a(l $(r.a l.r.a))
::
:: +pop: produce .head (leftmost item) and .rest or crash if empty
::
++ pop
~/ %pop
|= a=(tree item)
^- [head=item rest=(tree item)]
?~ a !!
?~ l.a [n.a r.a]
=/ l $(a l.a)
:- head.l
:: load .rest.l back into .a and rebalance
::
?: |(?=(~ rest.l) (mor key.n.a key.n.rest.l))
a(l rest.l)
rest.l(r a(r r.rest.l))
:: +pry: produce head (leftmost item) or null
::
++ pry
~/ %pry
|= a=(tree item)
^- (unit item)
?~ a ~
|-
?~ l.a `n.a
$(a l.a)
:: +put: ordered item insert
::
++ put
~/ %put
|= [a=(tree item) =key =val]
^- (tree item)
:: base case: replace null with single-item tree
::
?~ a [n=[key val] l=~ r=~]
:: base case: overwrite existing .key with new .val
::
?: =(key.n.a key) a(val.n val)
:: if item goes on left, recurse left then rebalance vertical order
::
?: (compare key key.n.a)
=/ l $(a l.a)
?> ?=(^ l)
?: (mor key.n.a key.n.l)
a(l l)
l(r a(l r.l))
:: item goes on right; recurse right then rebalance vertical order
::
=/ r $(a r.a)
?> ?=(^ r)
?: (mor key.n.a key.n.r)
a(r r)
r(l a(r l.r))
:: +ram: produce tail (rightmost item) or null
::
++ ram
~/ %ram
|= a=(tree item)
^- (unit item)
?~ a ~
|-
?~ r.a `n.a
$(a r.a)
:: +run: apply gate to transform all values in place
::
++ run
~/ %run
|* [a=(tree item) b=$-(val *)]
|-
?~ a a
[n=[key.n.a (b val.n.a)] l=$(a l.a) r=$(a r.a)]
:: +tab: tabulate a subset excluding start element with a max count
::
++ tab
~/ %tab
|= [a=(tree item) b=(unit key) c=@]
^- (list item)
|^
(flop e:(tabulate (del-span a b) b c))
::
++ tabulate
|= [a=(tree item) b=(unit key) c=@]
^- [d=@ e=(list item)]
?: ?&(?=(~ b) =(c 0))
[0 ~]
=| f=[d=@ e=(list item)]
|- ^+ f
?: ?|(?=(~ a) =(d.f c)) f
=. f $(a l.a)
?: =(d.f c) f
=. f [+(d.f) [n.a e.f]]
?:(=(d.f c) f $(a r.a))
::
++ del-span
|= [a=(tree item) b=(unit key)]
^- (tree item)
?~ a a
?~ b a
?: =(key.n.a u.b)
r.a
?: (compare key.n.a u.b)
$(a r.a)
a(l $(a l.a))
--
:: +tap: convert to list, left to right
::
++ tap
~/ %tap
|= a=(tree item)
^- (list item)
=| b=(list item)
|- ^+ b
?~ a b
$(a l.a, b [n.a $(a r.a)])
:: +uni: unify two ordered maps
::
:: .b takes precedence over .a if keys overlap.
::
++ uni
~/ %uni
|= [a=(tree item) b=(tree item)]
^- (tree item)
?~ b a
?~ a b
?: =(key.n.a key.n.b)
[n=n.b l=$(a l.a, b l.b) r=$(a r.a, b r.b)]
?: (mor key.n.a key.n.b)
?: (compare key.n.b key.n.a)
$(l.a $(a l.a, r.b ~), b r.b)
$(r.a $(a r.a, l.b ~), b l.b)
?: (compare key.n.a key.n.b)
$(l.b $(b l.b, r.a ~), a r.a)
$(r.b $(b r.b, l.a ~), a l.a)
--
:: ::
:::: ++userlib :: (2u) non-vane utils
@ -5636,7 +5744,8 @@
:: :: ++unm:chrono:userlib
++ unm :: Urbit to Unix ms
|= a=@da
(div (mul (sub a ~1970.1.1) 1.000) ~s1)
=- (div (mul - 1.000) ~s1)
(sub (add a (div ~s1 2.000)) ~1970.1.1)
:: :: ++unt:chrono:userlib
++ unt :: Urbit to Unix time
|= a=@da

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