tloncorp/landscape
1
1
Fork 0
mirror of https://github.com/tloncorp/landscape.git synced 2024-12-25 09:43:28 +03:00
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'master' into ns/lure-settings

Browse Source
This commit is contained in:
Hunter Miller 2023-03-28 16:52:43 -05:00
commit e1018d7a44
125 changed files with 823 additions and 13459 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
.github/helpers/deploy.sh vendored
View File

@ -18,13 +18,13 @@ cmds='
source_repo=$(mktemp --dry-run /tmp/repo.janeway.XXXXXXXXX)
git clone --depth 1 git@github.com:'$repo'.git $source_repo
urbit_repo=$(mktemp --dry-run /tmp/repo.urbit.XXXXXXXXX)
git clone --depth 1 git@github.com:urbit/urbit.git $urbit_repo
git clone --depth 1 git@github.com:urbit/urbit.git $urbit_repo -b '$URBIT_REPO_TAG' --single-branch
cd $source_repo
git checkout '$ref'
cd /home/urb || return
curl -s --data '\''{"source":{"dojo":"+hood/mount %'$desk'"},"sink":{"app":"hood"}}'\'' http://localhost:12321
rsync -avL --delete $source_repo/desk/ '$folder'
rsync -avL $urbit_repo/pkg/base-dev/ '$folder'
rsync -avL --delete $urbit_repo/pkg/base-dev/ '$folder'
rsync -avL $source_repo/desk/ '$folder'
curl -s --data '\''{"source":{"dojo":"+hood/commit %'$desk'"},"sink":{"app":"hood"}}'\'' http://localhost:12321
rm -rf $source_repo
rm -rf $urbit_repo

18
.github/workflows/add-to-project.yml vendored Normal file
View File

@ -0,0 +1,18 @@
name: Add issues to project
on:
issues:
types:
- opened
jobs:
add-to-project:
name: Add issue to project
runs-on: ubuntu-latest
steps:
- uses: actions/add-to-project@v0.4.0
with:
# You can target a repository in a different organization
# to the issue
project-url: https://github.com/orgs/tloncorp/projects/13
github-token: ${{ secrets.ADD_TO_PROJECT_PAT }}

3
.github/workflows/deploy-canary.yml vendored
View File

@ -24,4 +24,5 @@ jobs:
./.github/helpers/deploy.sh tloncorp/landscape garden binnec-dozzod-marzod us-west1-b ${{ github.event.inputs.tag }}
env:
SSH_SEC_KEY: ${{ secrets.JANEWAY_SSH_SEC_KEY }}
SSH_PUB_KEY: ${{ secrets.JANEWAY_SSH_PUB_KEY }}
SSH_PUB_KEY: ${{ secrets.JANEWAY_SSH_PUB_KEY }}
URBIT_REPO_TAG: ${{ vars.URBIT_REPO_TAG }}

3
.github/workflows/deploy-external.yml vendored
View File

@ -24,4 +24,5 @@ jobs:
./.github/helpers/deploy.sh tloncorp/landscape garden doznec-dozzod-marzod us-west1-b ${{ github.event.inputs.tag }}
env:
SSH_SEC_KEY: ${{ secrets.JANEWAY_SSH_SEC_KEY }}
SSH_PUB_KEY: ${{ secrets.JANEWAY_SSH_PUB_KEY }}
SSH_PUB_KEY: ${{ secrets.JANEWAY_SSH_PUB_KEY }}
URBIT_REPO_TAG: ${{ vars.URBIT_REPO_TAG }}

3
.github/workflows/deploy-internal.yml vendored
View File

@ -24,4 +24,5 @@ jobs:
./.github/helpers/deploy.sh tloncorp/landscape garden marnec-dozzod-marzod us-west1-b ${{ github.event.inputs.tag }}
env:
SSH_SEC_KEY: ${{ secrets.JANEWAY_SSH_SEC_KEY }}
SSH_PUB_KEY: ${{ secrets.JANEWAY_SSH_PUB_KEY }}
SSH_PUB_KEY: ${{ secrets.JANEWAY_SSH_PUB_KEY }}
URBIT_REPO_TAG: ${{ vars.URBIT_REPO_TAG }}

3
.github/workflows/deploy-live.yml vendored
View File

@ -24,4 +24,5 @@ jobs:
./.github/helpers/deploy.sh tloncorp/landscape garden mister-dister-dozzod-dozzod us-central1-a ${{ github.event.inputs.tag }}
env:
SSH_SEC_KEY: ${{ secrets.JANEWAY_SSH_SEC_KEY }}
SSH_PUB_KEY: ${{ secrets.JANEWAY_SSH_PUB_KEY }}
SSH_PUB_KEY: ${{ secrets.JANEWAY_SSH_PUB_KEY }}
URBIT_REPO_TAG: ${{ vars.URBIT_REPO_TAG }}

3
.github/workflows/deploy.yml vendored
View File

@ -42,4 +42,5 @@ jobs:
./.github/helpers/deploy.sh tloncorp/landscape garden wannec-dozzod-marzod us-west1-b
env:
SSH_SEC_KEY: ${{ secrets.JANEWAY_SSH_SEC_KEY }}
SSH_PUB_KEY: ${{ secrets.JANEWAY_SSH_PUB_KEY }}
SSH_PUB_KEY: ${{ secrets.JANEWAY_SSH_PUB_KEY }}
URBIT_REPO_TAG: ${{ vars.URBIT_REPO_TAG }}

6
desk/app/docket.hoon
View File

@ -1,5 +1,5 @@
/- *docket, hood, treaty
/+ *server, agentio, default-agent, multipart, dbug, verb
/+ *server, *hood, agentio, default-agent, multipart, dbug, verb
|%
+$ card card:agent:gall
+$ app-state
@ -229,7 +229,7 @@
?~ got=(~(get by tyr) desk)
~
?: ?& ?=(%dead zest.u.got)
?=(~ (get-apps-have:hood our.bowl desk now.bowl))
?=(~ (get-apps-have our.bowl desk now.bowl))
==
~
`u=[desk (get-light-charge charge)]
@ -389,6 +389,8 @@
?. (~(has by charges) desk)
`state
=/ =charge (~(got by charges) desk)
?: &(?=(%install -.chad.charge) ?=(%held zest))
`state
?- zest
%live
?. ?=(%glob -.href.docket.charge)

4
desk/desk.docket-0
View File

@ -1,10 +1,10 @@
:~ title+'Landscape'
info+'An app launcher for Urbit.'
color+0xee.5432
glob-http+['https://bootstrap.urbit.org/glob-0v1.1rr9r.up9nq.rdu14.vs42c.4gamh.glob' 0v1.1rr9r.up9nq.rdu14.vs42c.4gamh]
glob-http+['https://bootstrap.urbit.org/glob-0v3.2kc10.uqnbm.1ccad.rgp4g.61256.glob' 0v3.2kc10.uqnbm.1ccad.rgp4g.61256]
::glob-ames+~zod^0v0
base+'grid'
version+[1 5 0]
version+[1 7 0]
website+'https://tlon.io'
license+'MIT'
==

142
desk/lib/agentio.hoon
View File

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

466
desk/lib/azimuth.hoon
View File

@ -1,466 +0,0 @@
:: azimuth: constants and utilities
::
/+ ethereum
::
=> => [azimuth-types ethereum-types .]
|%
+$ complete-ship
$: state=point
history=(list diff-point) ::TODO maybe block/event nr? :: newest first
keys=(map life pass)
==
::
++ fleet (map @p complete-ship)
::
++ eth-type
|%
++ point
:~ [%bytes-n 32] :: encryptionKey
[%bytes-n 32] :: authenticationKey
%bool :: hasSponsor
%bool :: active
%bool :: escapeRequested
%uint :: sponsor
%uint :: escapeRequestedTo
%uint :: cryptoSuiteVersion
%uint :: keyRevisionNumber
%uint :: continuityNumber
==
++ deed
:~ %address :: owner
%address :: managementProxy
%address :: spawnProxy
%address :: votingProxy
%address :: transferProxy
==
--
::
++ eth-noun
|%
+$ point
$: encryption-key=octs
authentication-key=octs
has-sponsor=?
active=?
escape-requested=?
sponsor=@ud
escape-to=@ud
crypto-suite=@ud
key-revision=@ud
continuity-number=@ud
==
+$ deed
$: owner=address
management-proxy=address
spawn-proxy=address
voting-proxy=address
transfer-proxy=address
==
--
::
++ function
|%
++ azimuth
$% [%points who=@p]
[%rights who=@p]
[%get-spawned who=@p]
[%dns-domains ind=@ud]
==
--
::
:: # diffs
::
++ update
$% [%full ships=(map ship point) dns=dnses heard=events]
[%difs dis=(list (pair event-id diff-azimuth))]
==
::
:: # constants
::
:: contract addresses
++ contracts mainnet-contracts
++ mainnet-contracts
|%
:: azimuth: data contract
::
++ azimuth
0x223c.067f.8cf2.8ae1.73ee.5caf.ea60.ca44.c335.fecb
::
++ ecliptic
0x33ee.cbf9.0847.8c10.6146.26a9.d304.bfe1.8b78.dd73
::
++ linear-star-release
0x86cd.9cd0.992f.0423.1751.e376.1de4.5cec.ea5d.1801
::
++ conditional-star-release
0x8c24.1098.c3d3.498f.e126.1421.633f.d579.86d7.4aea
::
++ delegated-sending
0xf790.8ab1.f1e3.52f8.3c5e.bc75.051c.0565.aeae.a5fb
::
++ naive
0xeb70.029c.fb3c.53c7.78ea.f68c.d28d.e725.390a.1fe9
::
:: launch: block number of azimuth deploy
::
++ launch 6.784.800
::
:: public: block number of azimuth becoming independent
::
++ public 7.033.765
::
++ chain-id 1
--
::
:: Testnet contract addresses
::
++ ropsten-contracts
|%
++ azimuth
0x308a.b6a6.024c.f198.b57e.008d.0ac9.ad02.1988.6579
::
++ ecliptic
0x8b9f.86a2.8921.d9c7.05b3.113a.755f.b979.e1bd.1bce
::
++ linear-star-release
0x1f8e.dd03.1ee4.1474.0aed.b39b.84fb.8f2f.66ca.422f
::
++ conditional-star-release
0x0
::
++ delegated-sending
0x3e8c.a510.354b.c2fd.bbd6.1502.52d9.3105.c9c2.7bbe
::
++ naive
0xe7cf.4b83.06d3.11ba.ca15.585f.e3f0.7cd0.441c.21d1
::
++ launch 4.601.630
++ public launch
++ chain-id 3
--
::
:: Local contract addresses
::
:: These addresses are only reproducible if you use the deploy
:: script in bridge
::
++ local-contracts
|%
++ ecliptic
0x56db.68f2.9203.ff44.a803.faa2.404a.44ec.bb7a.7480
++ azimuth
0x863d.9c2e.5c4c.1335.96cf.ac29.d552.55f0.d0f8.6381
++ delegated-sending
0xb71c.0b6c.ee1b.cae5.6dfe.95cd.9d3e.41dd.d7ea.fc43
++ linear-star-release
0x3c3.dc12.be65.8158.d1d7.f9e6.6e08.ec40.99c5.68e4
++ conditional-star-release
0x35eb.3b10.2d9c.1b69.ac14.69c1.b1fe.1799.850c.d3eb
++ naive
0x6bb8.8a9b.bd82.be7a.997f.eb01.929c.6ec7.8988.fe12
++ launch 0
++ public 0
++ chain-id 1.337
--
::
:: ++ azimuth 0x863d.9c2e.5c4c.1335.96cf.ac29.d552.55f0.d0f8.6381 :: local bridge
:: hashes of ship event signatures
++ azimuth-events
|%
::
:: OwnerChanged(uint32,address)
++ owner-changed
0x16d0.f539.d49c.6cad.822b.767a.9445.bfb1.
cf7e.a6f2.a6c2.b120.a7ea.4cc7.660d.8fda
::
:: Activated(uint32)
++ activated
0xe74c.0380.9d07.69e1.b1f7.06cc.8414.258c.
d1f3.b6fe.020c.d15d.0165.c210.ba50.3a0f
::
:: Spawned(uint32,uint32)
++ spawned
0xb2d3.a6e7.a339.f5c8.ff96.265e.2f03.a010.
a854.1070.f374.4a24.7090.9644.1508.1546
::
:: EscapeRequested(uint32,uint32)
++ escape-requested
0xb4d4.850b.8f21.8218.141c.5665.cba3.79e5.
3e9b.b015.b51e.8d93.4be7.0210.aead.874a
::
:: EscapeCanceled(uint32,uint32)
++ escape-canceled
0xd653.bb0e.0bb7.ce83.93e6.24d9.8fbf.17cd.
a590.2c83.28ed.0cd0.9988.f368.90d9.932a
::
:: EscapeAccepted(uint32,uint32)
++ escape-accepted
0x7e44.7c9b.1bda.4b17.4b07.96e1.00bf.7f34.
ebf3.6dbb.7fe6.6549.0b1b.fce6.246a.9da5
::
:: LostSponsor(uint32,uint32)
++ lost-sponsor
0xd770.4f9a.2519.3dbd.0b0c.b4a8.09fe.ffff.
a7f1.9d1a.ae88.17a7.1346.c194.4482.10d5
::
:: ChangedKeys(uint32,bytes32,bytes32,uint32,uint32)
++ changed-keys
0xaa10.e7a0.117d.4323.f1d9.9d63.0ec1.69be.
bb3a.988e.8957.70e3.5198.7e01.ff54.23d5
::
:: BrokeContinuity(uint32,uint32)
++ broke-continuity
0x2929.4799.f1c2.1a37.ef83.8e15.f79d.d91b.
cee2.df99.d63c.d1c1.8ac9.68b1.2951.4e6e
::
:: ChangedSpawnProxy(uint32,address)
++ changed-spawn-proxy
0x9027.36af.7b3c.efe1.0d9e.840a.ed0d.687e.
35c8.4095.122b.2505.1a20.ead8.866f.006d
::
:: ChangedTransferProxy(uint32,address)
++ changed-transfer-proxy
0xcfe3.69b7.197e.7f0c.f067.93ae.2472.a9b1.
3583.fecb.ed2f.78df.a14d.1f10.796b.847c
::
:: ChangedManagementProxy(uint32,address)
++ changed-management-proxy
0xab9c.9327.cffd.2acc.168f.afed.be06.139f.
5f55.cb84.c761.df05.e051.1c25.1e2e.e9bf
::
:: ChangedVotingProxy(uint32,address)
++ changed-voting-proxy
0xcbd6.269e.c714.57f2.c7b1.a227.74f2.46f6.
c5a2.eae3.795e.d730.0db5.1768.0c61.c805
::
:: ChangedDns(string,string,string)
++ changed-dns
0xfafd.04ad.e1da.ae2e.1fdb.0fc1.cc6a.899f.
d424.063e.d5c9.2120.e67e.0730.53b9.4898
--
--
::
:: logic
::
|%
++ pass-from-eth
|= [enc=octs aut=octs sut=@ud]
^- pass
%^ cat 3 'b'
?. &(=(1 sut) =(p.enc 32) =(p.aut 32))
(cat 8 0 0)
(cat 8 q.aut q.enc)
::
++ point-from-eth
|= [who=@p point:eth-noun deed:eth-noun]
^- point
::
:: ownership
::
:+ :* owner
management-proxy
voting-proxy
transfer-proxy
==
::
:: network state
::
?. active ~
:- ~
:* key-revision
::
(pass-from-eth encryption-key authentication-key crypto-suite)
::
continuity-number
::
[has-sponsor `@p`sponsor]
::
?. escape-requested ~
``@p`escape-to
==
::
:: spawn state
::
?. ?=(?(%czar %king) (clan:title who)) ~
:- ~
:* spawn-proxy
~ ::TODO call getSpawned to fill this
==
::
++ event-log-to-point-diff
=, azimuth-events
=, abi:ethereum
|= log=event-log:rpc:ethereum
^- (unit (pair ship diff-point))
~? ?=(~ mined.log) %processing-unmined-event
::
?: =(i.topics.log owner-changed)
=/ [who=@ wer=address]
(decode-topics t.topics.log ~[%uint %address])
`[who %owner wer]
::
?: =(i.topics.log activated)
=/ who=@
(decode-topics t.topics.log ~[%uint])
`[who %activated who]
::
?: =(i.topics.log spawned)
=/ [pre=@ who=@]
(decode-topics t.topics.log ~[%uint %uint])
`[pre %spawned who]
::
?: =(i.topics.log escape-requested)
=/ [who=@ wer=@]
(decode-topics t.topics.log ~[%uint %uint])
`[who %escape `wer]
::
?: =(i.topics.log escape-canceled)
=/ who=@ (decode-topics t.topics.log ~[%uint])
`[who %escape ~]
::
?: =(i.topics.log escape-accepted)
=/ [who=@ wer=@]
(decode-topics t.topics.log ~[%uint %uint])
`[who %sponsor & wer]
::
?: =(i.topics.log lost-sponsor)
=/ [who=@ pos=@]
(decode-topics t.topics.log ~[%uint %uint])
`[who %sponsor | pos]
::
?: =(i.topics.log changed-keys)
=/ who=@ (decode-topics t.topics.log ~[%uint])
=/ [enc=octs aut=octs sut=@ud rev=@ud]
%+ decode-results data.log
~[[%bytes-n 32] [%bytes-n 32] %uint %uint]
`[who %keys rev (pass-from-eth enc aut sut)]
::
?: =(i.topics.log broke-continuity)
=/ who=@ (decode-topics t.topics.log ~[%uint])
=/ num=@ (decode-results data.log ~[%uint])
`[who %continuity num]
::
?: =(i.topics.log changed-management-proxy)
=/ [who=@ sox=address]
(decode-topics t.topics.log ~[%uint %address])
`[who %management-proxy sox]
::
?: =(i.topics.log changed-voting-proxy)
=/ [who=@ tox=address]
(decode-topics t.topics.log ~[%uint %address])
`[who %voting-proxy tox]
::
?: =(i.topics.log changed-spawn-proxy)
=/ [who=@ sox=address]
(decode-topics t.topics.log ~[%uint %address])
`[who %spawn-proxy sox]
::
?: =(i.topics.log changed-transfer-proxy)
=/ [who=@ tox=address]
(decode-topics t.topics.log ~[%uint %address])
`[who %transfer-proxy tox]
::
:: warn about unimplemented events, but ignore
:: the ones we know are harmless.
~? ?! .= i.topics.log
:: OwnershipTransferred(address,address)
0x8be0.079c.5316.5914.1344.cd1f.d0a4.f284.
1949.7f97.22a3.daaf.e3b4.186f.6b64.57e0
[%unimplemented-event i.topics.log]
~
::
++ apply-point-diff
|= [pot=point dif=diff-point]
^- point
?- -.dif
%full new.dif
::
%activated
%_ pot
net `[0 0 0 &^(^sein:title who.dif) ~]
kid ?. ?=(?(%czar %king) (clan:title who.dif)) ~
`[0x0 ~]
==
::
:: ownership
::
%owner pot(owner.own new.dif)
%transfer-proxy pot(transfer-proxy.own new.dif)
%management-proxy pot(management-proxy.own new.dif)
%voting-proxy pot(voting-proxy.own new.dif)
::
:: networking
::
?(%keys %continuity %sponsor %escape)
?> ?=(^ net.pot)
?- -.dif
%keys
pot(life.u.net life.dif, pass.u.net pass.dif)
::
%sponsor
%= pot
sponsor.u.net new.dif
escape.u.net ?:(has.new.dif ~ escape.u.net.pot)
==
::
%continuity pot(continuity-number.u.net new.dif)
%escape pot(escape.u.net new.dif)
==
::
:: spawning
::
?(%spawned %spawn-proxy)
?> ?=(^ kid.pot)
?- -.dif
%spawned
=- pot(spawned.u.kid -)
(~(put in spawned.u.kid.pot) who.dif)
::
%spawn-proxy pot(spawn-proxy.u.kid new.dif)
==
==
::
++ parse-id
|= id=@t
^- azimuth:function
|^
~| id
%+ rash id
;~ pose
(function %points 'points' shipname)
(function %get-spawned 'getSpawned' shipname)
(function %dns-domains 'dnsDomains' dem:ag)
==
::
++ function
|* [tag=@tas fun=@t rul=rule]
;~(plug (cold tag (jest fun)) (ifix [pal par] rul))
::
++ shipname
;~(pfix sig fed:ag)
--
::
++ function-to-call
|%
++ azimuth
|= cal=azimuth:function
^- [id=@t dat=call-data:rpc:ethereum]
?- -.cal
%points
:- (crip "points({(scow %p who.cal)})")
['points(uint32)' ~[uint+`@`who.cal]]
::
%rights
:- (crip "rights({(scow %p who.cal)})")
['rights(uint32)' ~[uint+`@`who.cal]]
::
%get-spawned
:- (crip "getSpawned({(scow %p who.cal)})")
['getSpawned(uint32)' ~[uint+`@`who.cal]]
::
%dns-domains
:- (crip "dnsDomains({(scow %ud ind.cal)})")
['dnsDomains(uint256)' ~[uint+ind.cal]]
==
--
--

146
desk/lib/azimuthio.hoon
View File

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

249
desk/lib/bip/b158.hoon
View File

@ -1,249 +0,0 @@
/- 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
desk/lib/bip/b173.hoon
View File

@ -1,144 +0,0 @@
:: 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"] [%regtest "bcrt"] ~])
++ 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)])]
--

184
desk/lib/bip/b174.hoon
View File

@ -1,184 +0,0 @@
:: 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
%regtest
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)
--

243
desk/lib/bip32.hoon
View File

@ -1,243 +0,0 @@
:: bip32 implementation in hoon
::
:: to use, call one of the core initialization arms.
:: using the produced core, derive as needed and take out the data you want.
::
::NOTE tested to be correct against
:: https://en.bitcoin.it/wiki/BIP_0032_TestVectors
::
=, hmac:crypto
=, secp:crypto
=+ ecc=secp256k1
::
:: prv: private key
:: pub: public key
:: cad: chain code
:: dep: depth in chain
:: ind: index at depth
:: pif: parent fingerprint (4 bytes)
|_ [prv=@ pub=point.ecc cad=@ dep=@ud ind=@ud pif=@]
::
+$ keyc [key=@ cai=@] :: prv/pub key + chain code
::
:: elliptic curve operations and values
::
++ point priv-to-pub.ecc
::
++ ser-p compress-point.ecc
::
++ n n:t.ecc
::
:: core initialization
::
++ from-seed
|= byts
^+ +>
=+ der=(hmac-sha512l [12 'dees nioctiB'] [wid dat])
=+ pri=(cut 3 [32 32] der)
+>.$(prv pri, pub (point pri), cad (cut 3 [0 32] der))
::
++ from-private
|= keyc
+>(prv key, pub (point key), cad cai)
::
++ from-public
|= keyc
+>(pub (decompress-point.ecc key), cad cai)
::
++ from-public-point
|= [pon=point.ecc cai=@]
+>(pub pon, cad cai)
::
++ from-extended
|= t=tape
=+ x=(de-base58check 4 t)
=> |%
++ take
|= b=@ud
^- [v=@ x=@]
:- (end [3 b] x)
(rsh [3 b] x)
--
=^ k x (take 33)
=^ c x (take 32)
=^ i x (take 4)
=^ p x (take 4)
=^ d x (take 1)
?> =(0 x) :: sanity check
%. [d i p]
=< set-metadata
=+ v=(swag [1 3] t)
?: =("prv" v) (from-private k c)
?: =("pub" v) (from-public k c)
!!
::
++ set-metadata
|= [d=@ud i=@ud p=@]
+>(dep d, ind i, pif p)
::
:: derivation
::
++ derivation-path
;~ pfix
;~(pose (jest 'm/') (easy ~))
%+ most fas
;~ pose
%+ cook
|=(i=@ (add i (bex 31)))
;~(sfix dem soq)
::
dem
== ==
::
++ derive-path
|= t=tape
%- derive-sequence
(scan t derivation-path)
::
++ derive-sequence
|= j=(list @u)
?~ j +>
=. +> (derive i.j)
$(j t.j)
::
++ derive
?: =(0 prv)
derive-public
derive-private
::
++ derive-private
|= i=@u
^+ +>
:: we must have a private key to derive the next one
?: =(0 prv)
~| %know-no-private-key
!!
:: derive child at i
=/ [left=@ right=@]
=- [(cut 3 [32 32] -) (cut 3 [0 32] -)]
%+ hmac-sha512l [32 cad]
:- 37
?: (gte i (bex 31))
:: hardened child
(can 3 ~[4^i 32^prv 1^0])
:: normal child
(can 3 ~[4^i 33^(ser-p (point prv))])
=+ key=(mod (add left prv) n)
:: rare exception, invalid key, go to the next one
?: |(=(0 key) (gte left n)) $(i +(i))
%_ +>.$
prv key
pub (point key)
cad right
dep +(dep)
ind i
pif fingerprint
==
::
++ derive-public
|= i=@u
^+ +>
:: public keys can't be hardened
?: (gte i (bex 31))
~| %cant-derive-hardened-public-key
!!
:: derive child at i
=/ [left=@ right=@]
=- [(cut 3 [32 32] -) (cut 3 [0 32] -)]
%+ hmac-sha512l [32 cad]
37^(can 3 ~[4^i 33^(ser-p pub)])
:: rare exception, invalid key, go to the next one
?: (gte left n) $(i +(i)) ::TODO or child key is "point at infinity"
%_ +>.$
pub (add-points.ecc (point left) pub)
cad right
dep +(dep)
ind i
pif fingerprint
==
::
:: rendering
::
++ private-key ?.(=(0 prv) prv ~|(%know-no-private-key !!))
++ public-key (ser-p pub)
++ chain-code cad
++ private-chain [private-key cad]
++ public-chain [public-key cad]
::
++ identity (hash160 public-key)
++ fingerprint (cut 3 [16 4] identity)
::
++ address
|= network=?(%main %regtest %testnet)
^- @uc
:: removes checksum
::
%+ rsh [3 4]
%+ en-base58check
[4 (version-bytes network %pub %.n)]
[20 identity]
::
++ prv-extended
|= network=?(%main %regtest %testnet)
%+ en-b58c-bip32 (version-bytes network %prv %.y)
(build-extended private-key)
::
++ pub-extended
|= network=?(%main %regtest %testnet)
%+ en-b58c-bip32 (version-bytes network %pub %.y)
(build-extended public-key)
::
++ build-extended
|= key=@
%+ can 3
:~ 33^key
32^cad
4^ind
4^pif
1^dep
==
::
++ en-b58c-bip32
|= [v=@ k=@]
%- en-base58:mimes:html
(en-base58check [4 v] [74 k])
::
:: base58check
::
++ en-base58check
:: v: version bytes
:: d: data
|= [v=byts d=byts]
=+ p=[(add wid.v wid.d) (can 3 ~[d v])]
=- (can 3 ~[4^- p])
%+ rsh [3 28]
(sha-256l:sha 32 (sha-256l:sha p))
::
++ de-base58check
:: vw: amount of version bytes
|= [vw=@u t=tape]
=+ x=(de-base58:mimes:html t)
=+ hash=(sha-256l:sha 32 (sha-256:sha (rsh [3 4] x)))
?> =((end [3 4] x) (rsh [3 28] hash))
(cut 3 [vw (sub (met 3 x) (add 4 vw))] x)
::
++ hash160
|= d=@
(ripemd-160:ripemd:crypto 32 (sha-256:sha d))
::
++ version-bytes
|= [network=?(%main %regtest %testnet) type=?(%pub %prv) bip32=?]
^- @ux
|^
?- type
%pub ?:(bip32 xpub-key pay-to-pubkey)
%prv ?:(bip32 xprv-key private-key)
==
::
++ pay-to-pubkey ?:(=(network %main) 0x0 0x6f)
++ private-key ?:(=(network %main) 0x80 0xef)
++ xpub-key ?:(=(network %main) 0x488.b21e 0x435.87cf)
++ xprv-key ?:(=(network %main) 0x488.ade4 0x435.8394)
--
--

46
desk/lib/bip39.hoon
View File

@ -1,46 +0,0 @@
:: bip39 implementation in hoon
::
/+ bip39-english
::
|%
++ from-entropy
|= byts
^- tape
=. wid (mul wid 8)
~| [%unsupported-entropy-bit-length wid]
?> &((gte wid 128) (lte wid 256))
::
=+ cs=(div wid 32)
=/ check=@
%+ rsh [0 (sub 256 cs)]
(sha-256l:sha (div wid 8) dat)
=/ bits=byts
:- (add wid cs)
%+ can 0
:~ cs^check
wid^dat
==
::
=/ pieces
|- ^- (list @)
:- (end [0 11] dat.bits)
?: (lte wid.bits 11) ~
$(bits [(sub wid.bits 11) (rsh [0 11] dat.bits)])
::
=/ words=(list tape)
%+ turn pieces
|= ind=@ud
(snag ind `(list tape)`bip39-english)
::
%+ roll (flop words)
|= [nex=tape all=tape]
?~ all nex
:(weld all " " nex)
::
::NOTE always produces a 512-bit result
++ to-seed
|= [mnem=tape pass=tape]
^- @
%- hmac-sha512t:pbkdf:crypto
[(crip mnem) (crip (weld "mnemonic" pass)) 2.048 64]
--

2052
desk/lib/bip39/english.hoon
View File

File diff suppressed because it is too large Load Diff

176
desk/lib/bitcoin-utils.hoon
View File

@ -1,176 +0,0 @@
:: lib/bitcoin-utils.hoon
:: Utilities for working with BTC data types and transactions
::
/- *bitcoin
~% %bitcoin-utils-lib ..part ~
|%
::
:: TODO: move this bit/byt stuff to zuse
:: bit/byte utilities
::
::
:: +blop: munge bit and byt sequences (cat, flip, take, drop)
::
++ blop
~/ %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
~/ %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
~/ %sha256
|= =byts
^- hexb
%- flip:byt
[32 (shay (flip:byt byts))]
::
++ dsha256
~/ %dsha256
|= =byts
(sha256 (sha256 byts))
::
++ hash-160
~/ %hash-160
|= val=byts
^- hexb
=, ripemd:crypto
:- 20
%- ripemd-160
(sha256 val)
::
:: hxb: hex parsing utilities
::
++ hxb
~% %hxb ..blop ~
|%
++ from-cord
~/ %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
::
=/ a (need (de:base16:mimes:html -))
[-.a `@ux`+.a]
::
++ to-cord
~/ %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
~% %csiz ..blop ~
|%
++ en
~/ %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
~/ %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]
--
--

61
desk/lib/cram.hoon
View File

@ -1,61 +0,0 @@
|%
++ static :: freeze .mdh hoon subset
|= gen=hoon ^- [inf=(map term dime) elm=manx]
?+ -.gen
=/ gen ~(open ap gen)
?: =(gen ^gen) ~|([%cram-dynamic -.gen] !!)
$(gen gen)
::
%xray [~ (single (shut gen))]
^ [(malt (frontmatter p.gen)) (single (shut q.gen))]
==
::
++ single :: unwrap one-elem marl
|= xml=marl ^- manx
?: ?=([* ~] xml) i.xml
~|(%many-elems !!)
::
++ shut-mart :: xml attrs
|=([n=mane v=(list beer:hoot)] [n (turn v |=(a=beer:hoot ?^(a !! a)))])
::
++ shut :: as xml constant
|= gen=hoon ^- marl
?+ -.gen ~|([%bad-xml -.gen] !!)
%dbug $(gen q.gen)
::
%xray
[[n.g.p.gen (turn a.g.p.gen shut-mart)] $(gen [%mcts c.p.gen])]~
::
%mcts
?~ p.gen ~
=- (weld - $(p.gen t.p.gen))
?^ -.i.p.gen $(gen [%xray i.p.gen])
~| [%shut-tuna -.i.p.gen]
?+ -.i.p.gen !!
%manx ?>(?=(%xray -.p.i.p.gen) $(gen p.i.p.gen))
%marl ?>(?=(%mcts -.p.i.p.gen) $(gen p.i.p.gen))
==
==
::
::
++ frontmatter :: parse ~[[%foo 1] [%bar ~s2]]
|= gen=hoon ^- (list [term dime])
?: ?=([%bust %null] gen) ~
?: ?=(%dbug -.gen) $(gen q.gen)
?. ?=(%clsg -.gen) ~|([%bad-frontmatter -.gen] !!)
%+ turn p.gen
|= gen=hoon
?. ?=(^ -.gen)
=/ gen ~(open ap gen)
?: =(gen ^gen) ~|([%bad-frontmatter-elem -.gen] !!)
$(gen gen)
=/ hed (as-dime p.gen)
?. =(%tas p.hed) ~|([%bad-frontmatter-key-type p.hed] !!)
[q.hed (as-dime q.gen)]
::
++ as-dime :: %foo ~.foo 0vbar etc
|= gen=hoon ^- dime
?: ?=(%dbug -.gen) $(gen q.gen)
?. ?=([?(%rock %sand) @ @] gen) ~|([%bad-literal gen] !!)
+.gen
--

155
desk/lib/dbug.hoon
View File

@ -1,155 +0,0 @@
:: dbug: agent wrapper for generic debugging tools
::
:: usage: %-(agent:dbug your-agent)
::
|%
+$ poke
$% [%bowl ~]
[%state grab=cord]
[%incoming =about]
[%outgoing =about]
==
::
+$ about
$@ ~
$% [%ship =ship]
[%path =path]
[%wire =wire]
[%term =term]
==
::
++ agent
|= =agent:gall
^- agent:gall
!.
|_ =bowl:gall
+* this .
ag ~(. agent bowl)
::
++ on-poke
|= [=mark =vase]
^- (quip card:agent:gall agent:gall)
?. ?=(%dbug mark)
=^ cards agent (on-poke:ag mark vase)
[cards this]
=/ dbug
!<(poke vase)
=; =tang
((%*(. slog pri 1) tang) [~ this])
?- -.dbug
%bowl [(sell !>(bowl))]~
::
%state
=? grab.dbug =('' grab.dbug) '-'
=; product=^vase
[(sell product)]~
=/ state=^vase
:: if the underlying app has implemented a /dbug/state scry endpoint,
:: use that vase in place of +on-save's.
::
=/ result=(each ^vase tang)
(mule |.(q:(need (need (on-peek:ag /x/dbug/state)))))
?:(?=(%& -.result) p.result on-save:ag)
%+ slap
(slop state !>([bowl=bowl ..zuse]))
(ream grab.dbug)
::
%incoming
=; =tang
?^ tang tang
[%leaf "no matching subscriptions"]~
%+ murn
%+ sort ~(tap by sup.bowl)
|= [[* a=[=ship =path]] [* b=[=ship =path]]]
(aor [path ship]:a [path ship]:b)
|= [=duct [=ship =path]]
^- (unit tank)
=; relevant=?
?. relevant ~
`>[path=path from=ship duct=duct]<
?: ?=(~ about.dbug) &
?- -.about.dbug
%ship =(ship ship.about.dbug)
%path ?=(^ (find path.about.dbug path))
%wire %+ lien duct
|=(=wire ?=(^ (find wire.about.dbug wire)))
%term !!
==
::
%outgoing
=; =tang
?^ tang tang
[%leaf "no matching subscriptions"]~
%+ murn
%+ sort ~(tap by wex.bowl)
|= [[[a=wire *] *] [[b=wire *] *]]
(aor a b)
|= [[=wire =ship =term] [acked=? =path]]
^- (unit tank)
=; relevant=?
?. relevant ~
`>[wire=wire agnt=[ship term] path=path ackd=acked]<
?: ?=(~ about.dbug) &
?- -.about.dbug
%ship =(ship ship.about.dbug)
%path ?=(^ (find path.about.dbug path))
%wire ?=(^ (find wire.about.dbug wire))
%term =(term term.about.dbug)
==
==
::
++ on-peek
|= =path
^- (unit (unit cage))
?. ?=([@ %dbug *] path)
(on-peek:ag path)
?+ path [~ ~]
[%u %dbug ~] ``noun+!>(&)
[%x %dbug %state ~] ``noun+!>(on-save:ag)
[%x %dbug %subscriptions ~] ``noun+!>([wex sup]:bowl)
==
::
++ on-init
^- (quip card:agent:gall agent:gall)
=^ cards agent on-init:ag
[cards this]
::
++ on-save on-save:ag
::
++ on-load
|= old-state=vase
^- (quip card:agent:gall agent:gall)
=^ cards agent (on-load:ag old-state)
[cards this]
::
++ on-watch
|= =path
^- (quip card:agent:gall agent:gall)
=^ cards agent (on-watch:ag path)
[cards this]
::
++ on-leave
|= =path
^- (quip card:agent:gall agent:gall)
=^ cards agent (on-leave:ag path)
[cards this]
::
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card:agent:gall agent:gall)
=^ cards agent (on-agent:ag wire sign)
[cards this]
::
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card:agent:gall agent:gall)
=^ cards agent (on-arvo:ag wire sign-arvo)
[cards this]
::
++ on-fail
|= [=term =tang]
^- (quip card:agent:gall agent:gall)
=^ cards agent (on-fail:ag term tang)
[cards this]
--
--

69
desk/lib/default-agent.hoon
View File

@ -1,69 +0,0 @@
/+ skeleton
|* [agent=* help=*]
?: ?=(%& help)
~| %default-agent-helpfully-crashing
skeleton
|_ =bowl:gall
++ on-init
`agent
::
++ on-save
!>(~)
::
++ on-load
|= old-state=vase
`agent
::
++ on-poke
|= =cage
~| "unexpected poke to {<dap.bowl>} with mark {<p.cage>}"
!!
::
++ on-watch
|= =path
~| "unexpected subscription to {<dap.bowl>} on path {<path>}"
!!
::
++ on-leave
|= path
`agent
::
++ on-peek
|= =path
~| "unexpected scry into {<dap.bowl>} on path {<path>}"
!!
::
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card:agent:gall _agent)
?- -.sign
%poke-ack
?~ p.sign
`agent
%- (slog leaf+"poke failed from {<dap.bowl>} on wire {<wire>}" u.p.sign)
`agent
::
%watch-ack
?~ p.sign
`agent
=/ =tank leaf+"subscribe failed from {<dap.bowl>} on wire {<wire>}"
%- (slog tank u.p.sign)
`agent
::
%kick `agent
%fact
~| "unexpected subscription update to {<dap.bowl>} on wire {<wire>}"
~| "with mark {<p.cage.sign>}"
!!
==
::
++ on-arvo
|= [=wire =sign-arvo]
~| "unexpected system response {<-.sign-arvo>} to {<dap.bowl>} on wire {<wire>}"
!!
::
++ on-fail
|= [=term =tang]
%- (slog leaf+"error in {<dap.bowl>}" >term< tang)
`agent
--

210
desk/lib/der.hoon
View File

@ -1,210 +0,0 @@
/- asn1
:: |der: distinguished encoding rules for ASN.1
::
:: DER is a tag-length-value binary encoding for ASN.1, designed
:: so that there is only one (distinguished) valid encoding for an
:: instance of a type.
::
|%
:: +en:der: encode +spec:asn1 to +octs (kindof)
::
++ en
=< |= a=spec:asn1
^- [len=@ud dat=@ux]
=/ b ~(ren raw a)
[(lent b) (rep 3 b)]
|%
:: +raw:en:der: door for encoding +spec:asn1 to list of bytes
::
++ raw
|_ pec=spec:asn1
:: +ren:raw:en:der: render +spec:asn1 to tag-length-value bytes
::
++ ren
^- (list @D)
=/ a lem
[tag (weld (len a) a)]
:: +tag:raw:en:der: tag byte
::
++ tag
^- @D
?- pec
[%int *] 2
[%bit *] 3
[%oct *] 4
[%nul *] 5
[%obj *] 6
[%seq *] 48 :: constructed: (con 0x20 16)
[%set *] 49 :: constructed: (con 0x20 17)
[%con *] ;: con
0x80 :: context-specifc
?:(imp.bes.pec 0 0x20) :: implicit?
(dis 0x1f tag.bes.pec) :: 5 bits of custom tag
==
==
:: +lem:raw:en:der: element bytes
::
++ lem
^- (list @D)
?- pec
:: unsigned only, interpreted as positive-signed and
:: rendered in big-endian byte order. negative-signed would
:: be two's complement
::
[%int *] =/ a (flop (rip 3 int.pec))
?~ a [0 ~]
?:((lte i.a 127) a [0 a])
:: padded to byte-width, must be already byte-aligned
::
[%bit *] =/ a (rip 3 bit.pec)
=/ b ~| %der-invalid-bit
?. =(0 (mod len.pec 8))
~|(%der-invalid-bit-alignment !!)
(sub (div len.pec 8) (lent a))
[0 (weld a (reap b 0))]
:: padded to byte-width
::
[%oct *] =/ a (rip 3 oct.pec)
=/ b ~| %der-invalid-oct
(sub len.pec (lent a))
(weld a (reap b 0))
::
[%nul *] ~
[%obj *] (rip 3 obj.pec)
::
[%seq *] %- zing
|- ^- (list (list @))
?~ seq.pec ~
:- ren(pec i.seq.pec)
$(seq.pec t.seq.pec)
:: presumed to be already deduplicated and sorted
::
[%set *] %- zing
|- ^- (list (list @))
?~ set.pec ~
:- ren(pec i.set.pec)
$(set.pec t.set.pec)
:: already constructed
::
[%con *] con.pec
==
:: +len:raw:en:der: length bytes
::
++ len
|= a=(list @D)
^- (list @D)
=/ b (lent a)
?: (lte b 127)
[b ~] :: note: big-endian
[(con 0x80 (met 3 b)) (flop (rip 3 b))]
--
--
:: +de:der: decode atom to +spec:asn1
::
++ de
|= [len=@ud dat=@ux]
^- (unit spec:asn1)
:: XX refactor into +parse
=/ a (rip 3 dat)
=/ b ~| %der-invalid-len
(sub len (lent a))
(rust `(list @D)`(weld a (reap b 0)) parse)
:: +parse:der: DER parser combinator
::
++ parse
=< ^- $-(nail (like spec:asn1))
;~ pose
(stag %int (bass 256 (sear int ;~(pfix (tag 2) till))))
(stag %bit (sear bit (boss 256 ;~(pfix (tag 3) till))))
(stag %oct (boss 256 ;~(pfix (tag 4) till)))
(stag %nul (cold ~ ;~(plug (tag 5) (tag 0))))
(stag %obj (^boss 256 ;~(pfix (tag 6) till)))
(stag %seq (sear recur ;~(pfix (tag 48) till)))
(stag %set (sear recur ;~(pfix (tag 49) till)))
(stag %con ;~(plug (sear context next) till))
==
|%
:: +tag:parse:der: parse tag byte
::
++ tag
|=(a=@D (just a))
:: +int:parse:der: sear unsigned big-endian bytes
::
++ int
|= a=(list @D)
^- (unit (list @D))
?~ a ~
?: ?=([@ ~] a) `a
?. =(0 i.a) `a
?.((gth i.t.a 127) ~ `t.a)
:: +bit:parse:der: convert bytewidth to bitwidth
::
++ bit
|= [len=@ud dat=@ux]
^- (unit [len=@ud dat=@ux])
?. =(0 (end 3 dat)) ~
:+ ~
(mul 8 (dec len))
(rsh 3 dat)
:: +recur:parse:der: parse bytes for a list of +spec:asn1
::
++ recur
|=(a=(list @) (rust a (star parse)))
:: +context:parse:der: decode context-specific tag byte
::
++ context
|= a=@D
^- (unit bespoke:asn1)
?. =(1 (cut 0 [7 1] a)) ~
:+ ~
=(1 (cut 0 [5 1] a))
(dis 0x1f a)
:: +boss:parse:der: shadowed to count as well
::
:: Use for parsing +octs more broadly?
::
++ boss
|* [wuc=@ tyd=rule]
%+ cook
|= waq=(list @)
:- (lent waq)
(reel waq |=([p=@ q=@] (add p (mul wuc q))))
tyd
:: +till:parse:der: parser combinator for len-prefixed bytes
::
:: advance until
::
++ till
|= tub=nail
^- (like (list @D))
?~ q.tub
(fail tub)
:: fuz: first byte - length, or length of the length
::
=* fuz i.q.tub
:: nex: offset of value bytes from fuz
:: len: length of value bytes
::
=/ [nex=@ len=@]
:: faz: meaningful bits in fuz
::
=/ faz (end [0 7] fuz)
?: =(0 (cut 0 [7 1] fuz))
[0 faz]
[faz (rep 3 (flop (scag faz t.q.tub)))]
?: ?& !=(0 nex)
!=(nex (met 3 len))
==
(fail tub)
:: zuf: value bytes
::
=/ zuf (swag [nex len] t.q.tub)
?. =(len (lent zuf))
(fail tub)
:: zaf: product nail
::
=/ zaf [p.p.tub (add +(nex) q.p.tub)]
[zaf `[zuf zaf (slag (add nex len) t.q.tub)]]
--
--

1000
desk/lib/ethereum.hoon
View File

File diff suppressed because it is too large Load Diff

289
desk/lib/ethio.hoon
View File

@ -1,289 +0,0 @@
:: ethio: Asynchronous Ethereum input/output functions.
::
/- rpc=json-rpc
/+ ethereum, strandio
=, ethereum-types
=, jael
::
=> |%
+$ topics (list ?(@ux (list @ux)))
--
|%
:: +request-rpc: send rpc request, with retry
::
++ request-rpc
|= [url=@ta id=(unit @t) req=request:rpc:ethereum]
=/ m (strand:strandio ,json)
^- form:m
;< res=(list [id=@t =json]) bind:m
(request-batch-rpc-strict url [id req]~)
?: ?=([* ~] res)
(pure:m json.i.res)
%+ strand-fail:strandio
%unexpected-multiple-results
[>(lent res)< ~]
:: +request-batch-rpc-strict: send rpc requests, with retry
::
:: sends a batch request. produces results for all requests in the batch,
:: but only if all of them are successful.
::
++ request-batch-rpc-strict
|= [url=@ta reqs=(list [id=(unit @t) req=request:rpc:ethereum])]
|^ %+ (retry:strandio results)
`10
attempt-request
::
+$ results (list [id=@t =json])
::
++ attempt-request
=/ m (strand:strandio ,(unit results))
^- form:m
;< responses=(list response:rpc) bind:m
(request-batch-rpc-loose url reqs)
=- ?~ err
(pure:m `res)
(pure:m ~)
%+ roll responses
|= $: rpc=response:rpc
[res=results err=(list [id=@t code=@t message=@t])]
==
?: ?=(%error -.rpc)
[res [+.rpc err]]
?. ?=(%result -.rpc)
[res [['' 'ethio-rpc-fail' (crip <rpc>)] err]]
[[+.rpc res] err]
--
:: +request-batch-rpc-loose: send rpc requests, with retry
::
:: sends a batch request. produces results for all requests in the batch,
:: including the ones that are unsuccessful.
::
++ request-batch-rpc-loose
|= [url=@ta reqs=(list [id=(unit @t) req=request:rpc:ethereum])]
|^ %+ (retry:strandio results)
`10
attempt-request
::
+$ result response:rpc
+$ results (list response:rpc)
::
++ attempt-request
=/ m (strand:strandio ,(unit results))
^- form:m
=/ =request:http
:* method=%'POST'
url=url
header-list=['Content-Type'^'application/json' ~]
::
^= body
%- some %- as-octt:mimes:html
%- en-json:html
a+(turn reqs request-to-json:rpc:ethereum)
==
;< ~ bind:m
(send-request:strandio request)
;< rep=(unit client-response:iris) bind:m
take-maybe-response:strandio
?~ rep
(pure:m ~)
(parse-responses u.rep)
::
++ parse-responses
|= =client-response:iris
=/ m (strand:strandio ,(unit results))
^- form:m
?> ?=(%finished -.client-response)
?~ full-file.client-response
(pure:m ~)
=/ body=@t q.data.u.full-file.client-response
=/ jon=(unit json) (de-json:html body)
?~ jon
(pure:m ~)
=/ array=(unit (list response:rpc))
((ar:dejs-soft:format parse-one-response) u.jon)
?~ array
(strand-fail:strandio %rpc-result-incomplete-batch >u.jon< ~)
(pure:m array)
::
++ parse-one-response
|= =json
^- (unit response:rpc)
?. &(?=([%o *] json) (~(has by p.json) 'error'))
=/ res=(unit [@t ^json])
%. json
=, dejs-soft:format
(ot id+so result+some ~)
?~ res ~
`[%result u.res]
~| parse-one-response=json
=/ error=(unit [id=@t ^json code=@ta mssg=@t])
%. json
=, dejs-soft:format
:: A 'result' member is present in the error
:: response when using ganache, even though
:: that goes against the JSON-RPC spec
::
(ot id+so result+some error+(ot code+no message+so ~) ~)
?~ error ~
=* err u.error
`[%error id.err code.err mssg.err]
--
::
:: +read-contract: calls a read function on a contract, produces result hex
::
++ read-contract
|= [url=@t req=proto-read-request:rpc:ethereum]
=/ m (strand:strandio ,@t)
;< res=(list [id=@t res=@t]) bind:m
(batch-read-contract-strict url [req]~)
?: ?=([* ~] res)
(pure:m res.i.res)
%+ strand-fail:strandio
%unexpected-multiple-results
[>(lent res)< ~]
:: +batch-read-contract-strict: calls read functions on contracts
::
:: sends a batch request. produces results for all requests in the batch,
:: but only if all of them are successful.
::
++ batch-read-contract-strict
|= [url=@t reqs=(list proto-read-request:rpc:ethereum)]
|^ =/ m (strand:strandio ,results)
^- form:m
;< res=(list [id=@t =json]) bind:m
%+ request-batch-rpc-strict url
(turn reqs proto-to-rpc)
=+ ^- [=results =failures]
(roll res response-to-result)
?~ failures (pure:m results)
(strand-fail:strandio %batch-read-failed-for >failures< ~)
::
+$ results (list [id=@t res=@t])
+$ failures (list [id=@t =json])
::
++ proto-to-rpc
|= proto-read-request:rpc:ethereum
^- [(unit @t) request:rpc:ethereum]
:- id
:+ %eth-call
^- call:rpc:ethereum
[~ to ~ ~ ~ `tape`(encode-call:rpc:ethereum function arguments)]
[%label %latest]
::
++ response-to-result
|= [[id=@t =json] =results =failures]
^+ [results failures]
?: ?=(%s -.json)
[[id^p.json results] failures]
[results [id^json failures]]
--
::
::
++ get-latest-block
|= url=@ta
=/ m (strand:strandio ,block)
^- form:m
;< =json bind:m
(request-rpc url `'block number' %eth-block-number ~)
(get-block-by-number url (parse-eth-block-number:rpc:ethereum json))
::
++ get-block-by-number
|= [url=@ta =number:block]
=/ m (strand:strandio ,block)
^- form:m
|^
%+ (retry:strandio ,block) `10
=/ m (strand:strandio ,(unit block))
^- form:m
;< =json bind:m
%+ request-rpc url
:- `'block by number'
[%eth-get-block-by-number number |]
(pure:m (parse-block json))
::
++ parse-block
|= =json
^- (unit block)
=< ?~(. ~ `[[&1 &2] |2]:u)
^- (unit [@ @ @])
~| json
%. json
=, dejs-soft:format
%- ot
:~ hash+parse-hex
number+parse-hex
'parentHash'^parse-hex
==
::
++ parse-hex |=(=json `(unit @)`(some (parse-hex-result:rpc:ethereum json)))
--
::
++ get-tx-by-hash
|= [url=@ta tx-hash=@ux]
=/ m (strand:strandio transaction-result:rpc:ethereum)
^- form:m
;< =json bind:m
%+ request-rpc url
:* `'tx by hash'
%eth-get-transaction-by-hash
tx-hash
==
%- pure:m
(parse-transaction-result:rpc:ethereum json)
::
++ get-logs-by-hash
|= [url=@ta =hash:block contracts=(list address) =topics]
=/ m (strand:strandio (list event-log:rpc:ethereum))
^- form:m
;< =json bind:m
%+ request-rpc url
:* `'logs by hash'
%eth-get-logs-by-hash
hash
contracts
topics
==
%- pure:m
(parse-event-logs:rpc:ethereum json)
::
++ get-logs-by-range
|= $: url=@ta
contracts=(list address)
=topics
=from=number:block
=to=number:block
==
=/ m (strand:strandio (list event-log:rpc:ethereum))
^- form:m
;< =json bind:m
%+ request-rpc url
:* `'logs by range'
%eth-get-logs
`number+from-number
`number+to-number
contracts
topics
==
%- pure:m
(parse-event-logs:rpc:ethereum json)
::
++ get-next-nonce
|= [url=@ta =address]
=/ m (strand:strandio ,@ud)
^- form:m
;< =json bind:m
%^ request-rpc url `'nonce'
[%eth-get-transaction-count address [%label %latest]]
%- pure:m
(parse-eth-get-transaction-count:rpc:ethereum json)
::
++ get-balance
|= [url=@ta =address]
=/ m (strand:strandio ,@ud)
^- form:m
;< =json bind:m
%^ request-rpc url `'balance'
[%eth-get-balance address [%label %latest]]
%- pure:m
(parse-eth-get-balance:rpc:ethereum json)
--

8
desk/lib/hood.hoon Normal file
View File

@ -0,0 +1,8 @@
=* dude dude:gall
|%
++ get-apps-have
|= [our=ship =desk now=@da]
^- (list [=dude live=?])
%~ tap in
.^((set [=dude live=?]) ge+/(scot %p our)/[desk]/(scot %da now))
--

214
desk/lib/jose.hoon
View File

@ -1,214 +0,0 @@
/+ primitive-rsa, *pkcs
=* rsa primitive-rsa
|%
:: +en-base64url: url-safe base64 encoding, without padding
::
++ en-base64url
~(en base64:mimes:html | &)
:: +de-base64url: url-safe base64 decoding, without padding
::
++ de-base64url
~(de base64:mimes:html | &)
:: |octn: encode/decode unsigned atoms as big-endian octet stream
::
++ octn
|%
++ en |=(a=@u `octs`[(met 3 a) (swp 3 a)])
++ de |=(a=octs `@u`(rev 3 p.a q.a))
--
:: +eor: explicit sort order comparator
::
:: Lookup :a and :b in :lit, and pass their indices to :com.
::
++ eor
|= [com=$-([@ @] ?) lit=(list)]
|= [a=* b=*]
^- ?
(fall (bind (both (find ~[a] lit) (find ~[b] lit)) com) |)
:: +en-json-sort: json encoding with sorted object keys
::
:: XX move %zuse with sorting optional?
::
++ en-json-sort :: XX rename
|^ |=([sor=$-(^ ?) val=json] (apex val sor ""))
:: :: ++apex:en-json:html
++ apex
=, en-json:html
|= [val=json sor=$-(^ ?) rez=tape]
^- tape
?~ val (weld "null" rez)
?- -.val
%a
:- '['
=. rez [']' rez]
!.
?~ p.val rez
|-
?~ t.p.val ^$(val i.p.val)
^$(val i.p.val, rez [',' $(p.val t.p.val)])
::
%b (weld ?:(p.val "true" "false") rez)
%n (weld (trip p.val) rez)
%s
:- '"'
=. rez ['"' rez]
=+ viz=(trip p.val)
!.
|- ^- tape
?~ viz rez
=+ hed=(jesc i.viz)
?: ?=([@ ~] hed)
[i.hed $(viz t.viz)]
(weld hed $(viz t.viz))
::
%o
:- '{'
=. rez ['}' rez]
=/ viz
%+ sort ~(tap by p.val)
|=((pair) (sor (head p) (head q)))
?~ viz rez
!.
|- ^+ rez
?~ t.viz ^$(val [%s p.i.viz], rez [':' ^$(val q.i.viz)])
=. rez [',' $(viz t.viz)]
^$(val [%s p.i.viz], rez [':' ^$(val q.i.viz)])
==
--
:: %/lib/jose
::
:: |jwk: json representations of cryptographic keys (rfc7517)
::
:: Url-safe base64 encoding of key parameters in big-endian byte order.
:: RSA-only for now
::
++ jwk
|%
:: |en:jwk: encoding of json cryptographic keys
::
++ en
=> |%
:: +numb:en:jwk: base64-url encode big-endian number
::
++ numb (corl en-base64url en:octn)
--
|%
:: +pass:en:jwk: json encode public key
::
++ pass
|= k=key:rsa
^- json
[%o (my kty+s+'RSA' n+s+(numb n.pub.k) e+s+(numb e.pub.k) ~)]
:: +ring:en:jwk: json encode private key
::
++ ring
|= k=key:rsa
^- json
~| %rsa-need-ring
?> ?=(^ sek.k)
:- %o %- my :~
kty+s+'RSA'
n+s+(numb n.pub.k)
e+s+(numb e.pub.k)
d+s+(numb d.u.sek.k)
p+s+(numb p.u.sek.k)
q+s+(numb q.u.sek.k)
==
--
:: |de:jwk: decoding of json cryptographic keys
::
++ de
=, dejs-soft:format
=> |%
:: +numb:de:jwk: parse base64-url big-endian number
::
++ numb (cu (cork de-base64url (lift de:octn)) so)
--
|%
:: +pass:de:jwk: decode json public key
::
++ pass
%+ ci
=/ a (unit @ux)
|= [kty=@t n=a e=a]
^- (unit key:rsa)
=/ pub (both n e)
?~(pub ~ `[u.pub ~])
(ot kty+(su (jest 'RSA')) n+numb e+numb ~)
:: +ring:de:jwk: decode json private key
::
++ ring
%+ ci
=/ a (unit @ux)
|= [kty=@t n=a e=a d=a p=a q=a]
^- (unit key:rsa)
=/ pub (both n e)
=/ sek :(both d p q)
?:(|(?=(~ pub) ?=(~ sek)) ~ `[u.pub sek])
(ot kty+(su (jest 'RSA')) n+numb e+numb d+numb p+numb q+numb ~)
--
:: |thumb:jwk: "thumbprint" json-encoded key (rfc7638)
::
++ thumb
|%
:: +pass:thumb:jwk: thumbprint json-encoded public key
::
++ pass
|= k=key:rsa
(en-base64url 32 (shax (crip (en-json-sort aor (pass:en k)))))
:: +ring:thumb:jwk: thumbprint json-encoded private key
::
++ ring !!
--
--
:: |jws: json web signatures (rfc7515)
::
:: Note: flattened signature form only.
::
++ jws
|%
:: +sign:jws: sign json value
::
++ sign
|= [k=key:rsa pro=json lod=json]
|^ ^- json
=. pro header
=/ protect=cord (encode pro)
=/ payload=cord (encode lod)
:- %o %- my :~
protected+s+protect
payload+s+payload
signature+s+(sign protect payload)
==
:: +header:sign:jws: set signature algorithm in header
::
++ header
?> ?=([%o *] pro)
^- json
[%o (~(put by p.pro) %alg s+'RS256')]
:: +encode:sign:jws: encode json for signing
::
:: Alphabetically sort object keys, url-safe base64 encode
:: the serialized json.
::
++ encode
|= jon=json
%- en-base64url
%- as-octt:mimes:html
(en-json-sort aor jon)
:: +sign:sign:jws: compute signature
::
:: Url-safe base64 encode in big-endian byte order.
::
++ sign
|= [protect=cord payload=cord]
=/ msg=@t (rap 3 ~[protect '.' payload])
=/ sig=@ud (~(sign rs256 k) (met 3 msg) msg)
=/ len=@ud (met 3 n.pub.k)
(en-base64url len (rev 3 len sig))
--
:: +verify:jws: verify signature
::
++ verify !!
--
--

112
desk/lib/keygen.hoon
View File

@ -1,112 +0,0 @@
:: urbit-style key generation and derivation functions
::
/- keygen
::
/+ ethereum, bip32, bip39
::
=, keygen
::
|%
++ argon2u
|= [who=ship tic=byts]
^- @
~| [%who who (met 3 who)]
:: ?> (lte (met 3 who) 4)
%- (argon2-urbit:argon2:crypto 32)
:- tic
=- [(met 3 -) (swp 3 -)]
%- crip
(weld "urbitkeygen" (a-co:co who))
::
++ child-node-from-seed
|= [seed=@ typ=tape pass=(unit @t)]
^- node
=+ sed=(seed:ds 32^seed typ)
=+ nom=(from-entropy:bip39 32^sed)
:+ typ nom
%- wallet:ds
%+ to-seed:bip39 nom
(trip (fall pass ''))
::
++ derive-network-seed
|= [mngs=@ rev=@ud]
^- @ux
=+ (seed:ds 64^mngs (weld "network" (a-co:co rev)))
?: =(0 rev) -
:: hash again to prevent length extension attacks
(sha-256l:sha 32 -)
::
++ ownership-wallet-from-ticket
|= [who=ship ticket=byts pass=(unit @t)]
^- node
=+ master-seed=(argon2u who ticket)
(child-node-from-seed master-seed "ownership" pass)
::
++ full-wallet-from-ticket
:: who: username
:: ticket: password
:: rev: network key revision
:: pass: optional passphrase
::
|= [who=ship ticket=byts rev=@ud pass=(unit @t)]
^- vault
=+ master-seed=(argon2u who ticket)
=/ cn :: child node
|= typ=nodetype
(child-node-from-seed master-seed typ pass)
::
:- ^= ownership ^- node
(cn "ownership")
::
:- ^= voting ^- node
(cn "voting")
::
=/ management=node
(cn "management")
:- management=management
::
:- ^= transfer ^- node
(cn "transfer")
::
:- ^= spawn ^- node
(cn "spawn")
::
^= network ^- uode
=/ mad :: management seed
%+ to-seed:bip39
seed:management
(trip (fall pass ''))
=+ sed=(derive-network-seed mad rev)
[rev sed (urbit:ds sed)]
::
++ ds :: derive from raw seed
|%
++ wallet
|= seed=@
^- ^wallet
=+ => (from-seed:bip32 64^seed)
(derive-path "m/44'/60'/0'/0/0")
:+ [public-key private-key]
(address-from-prv:key:ethereum private-key)
chain-code
::
++ urbit
|= seed=@
^- edkeys
=+ =< [pub=pub:ex sec=sec:ex]
(pit:nu:crub:crypto 256 seed)
:- ^= auth
:- (rsh 3 (end [3 33] pub))
(rsh 3 (end [3 33] sec))
^= crypt
:- (rsh [3 33] pub)
(rsh [3 33] sec)
::
++ seed
|= [seed=byts salt=tape]
^- @ux
%- sha-256l:sha
:- (add wid.seed (lent salt))
(cat 3 (crip (flop salt)) dat.seed)
--
--

61
desk/lib/language-server/build.hoon
View File

@ -1,61 +0,0 @@
/- *language-server
::
|%
++ parse-error
|= =tape
^- (unit [=path =range])
=/ parse-pair
%+ cook
|=([row=@ud col=@ud] [(dec row) col])
(ifix [sel ser] ;~((glue ace) dem dem))
=/ parse-path
%+ cook
|=(p=path (slag 3 p))
(ifix [fas (jest '::')] (more fas urs:ab))
=/ parse-full
;~(plug parse-path ;~(sfix ;~((glue dot) parse-pair parse-pair) gar))
(rust tape parse-full)
::
++ get-errors-from-tang
|= [uri=@t =tang]
^- (list range)
=/ =path
(uri-to-path uri)
%+ murn tang
|= =tank
^- (unit range)
?. ?=([%leaf *] tank)
~
=/ error
(parse-error p.tank)
?~ error
~
?: =(path path.u.error)
`range.u.error
~
::
++ uri-to-path
|= uri=@t
^- path
=/ pier-root=(set cord)
%- sy
['app' 'gen' 'lib' 'mar' 'ren' 'sur' 'sys' 'test' ~]
=/ path=(list cord)
(parse-uri uri)
|-
?< ?=(~ path)
?: (~(has in pier-root) i.path)
`^path`path
$(path t.path)
::
++ parse-uri
|= uri=@t
=- (fall - /fail)
%+ rush uri
%+ more
;~(pose (plus fas) dot)
%+ cook
crip
(star ;~(pose col hep alf))
::
--

386
desk/lib/language-server/complete.hoon
View File

@ -1,386 +0,0 @@
/+ language-server-parser
:: Autocomplete for hoon.
::
=/ debug |
|%
+* option [item]
[term=cord detail=item]
::
:: Like +rose except also produces line number
::
++ lily
|* [los=tape sab=rule]
=+ vex=(sab [[1 1] los])
?~ q.vex
[%| p=p.vex(q (dec q.p.vex))]
?. =(~ q.q.u.q.vex)
[%| p=p.vex(q (dec q.p.vex))]
[%& p=p.u.q.vex]
::
:: Get all the identifiers accessible if this type is your subject.
::
++ get-identifiers
|= ty=type
%- flop
|- ^- (list (option type))
?- ty
%noun ~
%void ~
[%atom *] ~
[%cell *]
%+ weld
$(ty p.ty)
$(ty q.ty)
::
[%core *]
%- weld
:_ ?. ?=(%gold r.p.q.ty)
~
$(ty p.ty)
^- (list (option type))
%- zing
%+ turn ~(tap by q.r.q.ty)
|= [term =tome]
%+ turn
~(tap by q.tome)
|= [name=term =hoon]
^- (pair term type)
~| term=term
[name ~(play ~(et ut ty) ~[name] ~)]
::
[%face *]
?^ p.ty
~
[p.ty q.ty]~
::
[%fork *]
%= $
ty
=/ tines ~(tap in p.ty)
?~ tines
%void
|- ^- type
?~ t.tines
i.tines
(~(fuse ut $(tines t.tines)) i.tines)
==
::
[%hint *] $(ty q.ty)
[%hold *] $(ty ~(repo ut ty))
==
::
++ search-exact
|* [sid=term options=(list (option))]
=/ match
%+ skim options
|= [id=cord *]
=(sid id)
?~ match
~
[~ i.match]
::
:: Get all the identifiers that start with sid.
::
++ search-prefix
|* [sid=cord ids=(list (option))]
^+ ids
%+ skim ids
|= [id=cord *]
^- ?(%.y %.n)
=(sid (end [3 (met 3 sid)] id))
::
:: Get the longest prefix of a list of identifiers.
::
++ longest-match
|= matches=(list (option))
^- cord
?~ matches
''
=/ n 1
=/ last (met 3 term.i.matches)
|- ^- term
?: (gth n last)
term.i.matches
=/ prefix (end [3 n] term.i.matches)
?: |- ^- ?
?| ?=(~ t.matches)
?& =(prefix (end [3 n] term.i.t.matches))
$(t.matches t.t.matches)
== ==
$(n +(n))
(end [3 (dec n)] term.i.matches)
::
:: Run +find-type safely, printing the first line of the stack trace on
:: error.
::
++ find-type-mule
|= [sut=type gen=hoon]
^- (unit [term type])
=/ res (mule |.((find-type sut gen)))
?- -.res
%& p.res
%| ((slog (flop (scag 10 p.res))) ~)
==
::
:: Get the subject type of the wing where you've put the "magic-spoon".
::
++ find-type
|= [sut=type gen=hoon]
=* loop $
|^
^- (unit [term type])
?- gen
[%cnts [%magic-spoon ~] *] `['' sut]
[%cnts [%magic-spoon @ ~] *] `[i.t.p.gen sut]
[%cnts [%magic-spoon @ *] *]
%= $
sut (~(play ut sut) wing+t.t.p.gen)
t.p.gen t.p.gen(t ~)
==
::
[%cnts [%magic-fork @ ~] *]
`['' (~(play ut sut) wing+t.p.gen)]
::
[^ *] (both p.gen q.gen)
[%brcn *] (grow q.gen)
[%brpt *] (grow q.gen)
[%cnts *]
|- ^- (unit [term type])
=* inner-loop $
?~ q.gen
~
%+ replace
loop(gen q.i.q.gen)
|. inner-loop(q.gen t.q.gen)
::
[%dtkt *] (spec-and-hoon p.gen q.gen)
[%dtls *] loop(gen p.gen)
[%rock *] ~
[%sand *] ~
[%tune *] ~
[%dttr *] (both p.gen q.gen)
[%dtts *] (both p.gen q.gen)
[%dtwt *] loop(gen p.gen)
[%hand *] ~
[%ktbr *] loop(gen p.gen)
[%ktls *] (both p.gen q.gen)
[%ktpm *] loop(gen p.gen)
[%ktsg *] loop(gen p.gen)
[%ktwt *] loop(gen p.gen)
[%note *] loop(gen q.gen)
[%sgzp *] (both p.gen q.gen)
[%sggr *] loop(gen q.gen) :: should check for hoon in p.gen
[%tsgr *] (change p.gen q.gen)
[%tscm *]
%+ replace
loop(gen p.gen)
|.(loop(gen q.gen, sut (~(busk ut sut) p.gen)))
::
[%wtcl *] (bell p.gen q.gen r.gen)
[%fits *] (both p.gen wing+q.gen)
[%wthx *] loop(gen wing+q.gen)
[%dbug *] loop(gen q.gen)
[%zpcm *] (both p.gen q.gen)
[%lost *] loop(gen p.gen)
[%zpmc *] (both p.gen q.gen)
[%zpts *] loop(gen p.gen)
[%zppt *] (both q.gen r.gen)
[%zpgl *] (spec-and-hoon p.gen q.gen)
[%zpzp *] ~
*
=+ doz=~(open ap gen)
?: =(doz gen)
~_ (show [%c 'hoon'] [%q gen])
~> %mean.'play-open'
!!
loop(gen doz)
==
::
++ replace
|= [a=(unit [term type]) b=(trap (unit [term type]))]
^- (unit [term type])
?~(a $:b a)
::
++ both
|= [a=hoon b=hoon]
(replace loop(gen a) |.(loop(gen b)))
::
++ bell
|= [a=hoon b=hoon c=hoon]
%+ replace loop(gen a)
|. %+ replace loop(gen b, sut (~(gain ut sut) a))
|. loop(gen c, sut (~(lose ut sut) a))
::
++ spec-and-hoon
|= [a=spec b=hoon]
(replace (find-type-in-spec sut a) |.(loop(gen b)))
::
++ change
|= [a=hoon b=hoon]
(replace loop(gen a) |.(loop(gen b, sut (~(play ut sut) a))))
::
++ grow
|= m=(map term tome)
=/ tomes ~(tap by m)
|- ^- (unit [term type])
=* outer-loop $
?~ tomes
~
=/ arms ~(tap by q.q.i.tomes)
|- ^- (unit [term type])
=* inner-loop $
?~ arms
outer-loop(tomes t.tomes)
%+ replace
loop(gen q.i.arms, sut (~(play ut sut) gen))
|. inner-loop(arms t.arms)
--
::
:: Not implemented yet. I wonder whether we should modify types found
:: in spec mode such that if it's a mold that produces a type, it
:: should just display the type and not that it's technically a
:: function.
::
++ find-type-in-spec
|= [sut=type pec=spec]
^- (unit [term type])
~
::
++ get-id-sym
|= [pos=@ud =tape]
%^ get-id pos tape
^- $-(nail (like (unit @t)))
;~(sfix (punt sym) (star ;~(pose prn (just `@`10))))
::
++ get-id-cord
|= [pos=@ud =tape]
%^ get-id pos tape
^- $-(nail (like (unit @t)))
;~(sfix (punt (cook crip (star prn))) (star ;~(pose prn (just `@`10))))
::
++ get-id
|= [pos=@ud txt=tape seek=$-(nail (like (unit @t)))]
^- [forward=(unit @t) backward=(unit @t) id=(unit @t)]
=/ forward=(unit @t)
(scan (slag pos txt) seek)
=/ backward=(unit @t)
%- (lift |=(t=@t (swp 3 t)))
(scan (flop (scag pos txt)) seek)
=/ id=(unit @t)
?~ forward
?~ backward
~
`u.backward
?~ backward
`u.forward
`(cat 3 u.backward u.forward)
[forward backward id]
::
:: Insert magic marker in hoon source at the given position.
::
++ insert-magic
|= [pos=@ud txt=tape]
^- [back-pos=@ud fore-pos=@ud txt=tape]
:: Find beg-pos by searching backward to where the current term
:: begins
=+ (get-id-sym pos txt)
=/ back-pos
?~ backward
pos
(sub pos (met 3 u.backward))
=/ fore-pos
?~ forward
pos
(add pos (met 3 u.forward))
:+ back-pos fore-pos
:: Insert "magic-spoon" marker so +find-type can identify where to
:: stop.
::
;: weld
(scag back-pos txt)
?: &(?=(~ id) ?=([%'.' *] (slag pos txt)))
"magic-fork"
"magic-spoon"
?~ id
""
"."
(slag back-pos txt)
"\0a"
==
::
:: Produce the longest possible advance without choosing between
:: matches.
::
:: Takes a +hoon which has already has a magic-spoon marker. Useful if
:: you want to handle your own parsing.
::
++ advance-hoon
|= [sut=type gen=hoon]
%+ bind (find-type-mule sut gen)
|= [id=term typ=type]
=/ matches=(list (option type))
(search-prefix id (get-identifiers typ))
(longest-match matches)
::
:: Same as +advance-hoon, but takes a position and text directly.
::
++ advance-tape
|= [sut=type pos=@ud code=tape]
(advance-hoon sut (scan txt:(insert-magic pos code) vest))
::
:: Produce a list of matches.
::
:: Takes a +hoon which has already has a magic-spoon marker. Useful if
:: you want to handle your own parsing.
::
++ tab-list-hoon
|= [sut=type gen=hoon]
^- (unit (list (option type)))
%+ bind (find-type-mule sut gen)
|= [id=term typ=type]
(search-prefix id (get-identifiers typ))
::
:: Same as +advance-hoon, but takes a position and text directly.
::
++ tab-list-tape
|= [sut=type pos=@ud code=tape]
^- (each (unit (list (option type))) [row=@ col=@])
~? > debug %start-magick
=/ magicked txt:(insert-magic pos code)
~? > debug %start-parsing
=/ res (lily magicked (language-server-parser *path))
?: ?=(%| -.res)
~? > debug [%parsing-error p.res]
[%| p.res]
:- %&
~? > debug %parsed-good
((cury tab-list-hoon sut) hoon:`pile:clay`p.res)
::
:: Generators
++ tab-generators
|= [pfix=path app=(unit term) gens=(list term)]
^- (list (option tank))
%+ turn gens
|= gen=term
^- (option tank)
=/ pax=path
(weld pfix ~[gen %hoon])
=/ file
.^(@t %cx pax)
:_ (render-help file)
?~ app
(cat 3 '+' gen)
?: =(%hood u.app)
(cat 3 '|' gen)
:((cury cat 3) ':' u.app '|' gen)
:: Stolen from +help
++ render-help
|= a=@t
^- tank
:- %leaf
=/ c (to-wain:format a)
?~ c "~"
?. =(':: ' (end [3 4] i.c))
"<undocumented>"
(trip i.c)
--

484
desk/lib/language-server/easy-print.hoon
View File

@ -1,484 +0,0 @@
:: Fast type printing that's easy on the eyes or your money back
::
=> |%
+$ cape [p=(map @ud wine) q=wine]
+$ wine
$@ $? %noun
%path
%type
%void
%wall
%wool
%yarn
==
$% [%mato p=term]
[%gate p=hoon q=type r=wine]
[%core p=(list @ta) q=wine]
[%face p=term q=wine]
[%list p=term q=wine]
[%pear p=term q=@]
[%bcwt p=(list wine)]
[%plot p=(list wine)]
[%stop p=@ud]
[%tree p=term q=wine]
[%unit p=term q=wine]
==
--
|_ sut=type
++ dash
|= [mil=tape lim=char lam=tape]
^- tape
=/ esc (~(gas in *(set @tD)) lam)
:- lim
|- ^- tape
?~ mil [lim ~]
?: ?| =(lim i.mil)
=('\\' i.mil)
(~(has in esc) i.mil)
==
['\\' i.mil $(mil t.mil)]
?: (lte ' ' i.mil)
[i.mil $(mil t.mil)]
['\\' ~(x ne (rsh 2 i.mil)) ~(x ne (end 2 i.mil)) $(mil t.mil)]
::
++ deal |=(lum=* (dish dole lum))
++ dial
|= ham=cape
=+ gid=*(set @ud)
=| top-level=? :: don't need circumfix punctuation
=< `tank`-:$
|%
++ many
|= haz=(list wine)
^- [(list tank) (set @ud)]
?~ haz [~ gid]
=^ mor gid $(haz t.haz)
=^ dis gid ^$(q.ham i.haz)
[[dis mor] gid]
::
++ $
^- [tank (set @ud)]
?- q.ham
%noun :_(gid [%leaf '*' ~])
%path :_(gid [%leaf '/' ~])
%type :_(gid [%leaf '#' 't' ~])
%void :_(gid [%leaf '#' '!' ~])
%wool :_(gid [%leaf '*' '"' '"' ~])
%wall :_(gid [%leaf '*' '\'' '\'' ~])
%yarn :_(gid [%leaf '"' '"' ~])
[%mato *] :_(gid [%leaf '@' (trip p.q.ham)])
[%gate *]
=^ sam gid
?. ?=([%plot * * *] r.q.ham)
?: ?=(%plot -.r.q.ham)
%- (slog -:$(q.ham r.q.ham) ~)
`gid
`gid
[`u=- +]:$(q.ham i.p.r.q.ham, top-level |)
:_ gid
:+ %rose
:- ?> ?=(%core -.q.q.ham)
?: ?=(%dry q.p.q.q.q.ham)
" -> "
" ~> "
?: top-level
["" ""]
["(" ")"]
:+ ?~(sam leaf+"_" u.sam)
=/ res (mule |.((~(play ut q.q.ham) p.q.ham)))
?- -.res
%& duck(sut p.res)
%| leaf+"###"
==
~
::
[%core *]
=^ sam gid
?. ?=([%plot * * ~] q.q.ham)
`gid
[`u=- +]:$(q.ham i.p.q.q.ham)
:_ gid
?~ sam
:+ %rose
[[' ' ~] ['<' ~] ['>' ~]]
|- ^- (list tank)
?~ p.q.ham ~
[[%leaf (rip 3 i.p.q.ham)] $(p.q.ham t.p.q.ham)]
:+ %rose
[" -> " "" ""]
:+ u.sam
:+ %rose
[[' ' ~] ['<' ~] ['>' ~]]
|- ^- (list tank)
?~ p.q.ham ~
[[%leaf (rip 3 i.p.q.ham)] $(p.q.ham t.p.q.ham)]
~
::
[%face *]
=^ cox gid $(q.ham q.q.ham)
:_(gid [%palm [['=' ~] ~ ~ ~] [%leaf (trip p.q.ham)] cox ~])
::
[%list *]
=^ cox gid $(q.ham q.q.ham)
:_(gid [%rose [" " (weld (trip p.q.ham) "(") ")"] cox ~])
::
[%bcwt *]
=^ coz gid (many p.q.ham)
:_(gid [%rose [[' ' ~] ['?' '(' ~] [')' ~]] coz])
::
[%plot *]
=^ coz gid (many p.q.ham)
:_(gid [%rose [[' ' ~] ['[' ~] [']' ~]] coz])
::
[%pear *]
:_(gid [%leaf '$' ~(rend co [%$ p.q.ham q.q.ham])])
::
[%stop *]
=+ num=~(rend co [%$ %ud p.q.ham])
?: (~(has in gid) p.q.ham)
:_(gid [%leaf '#' num])
=^ cox gid
%= $
gid (~(put in gid) p.q.ham)
q.ham (~(got by p.ham) p.q.ham)
==
:_(gid [%palm [['.' ~] ~ ~ ~] [%leaf ['^' '#' num]] cox ~])
::
[%tree *]
=^ cox gid $(q.ham q.q.ham)
:_(gid [%rose [" " (weld (trip p.q.ham) "(") ")"] cox ~])
::
[%unit *]
=^ cox gid $(q.ham q.q.ham)
:_(gid [%rose [" " (weld (trip p.q.ham) "(") ")"] cox ~])
==
--
::
++ dish !:
|= [ham=cape lum=*] ^- tank
~| [%dish-h ?@(q.ham q.ham -.q.ham)]
~| [%lump lum]
~| [%ham ham]
%- need
=| gil=(set [@ud *])
|- ^- (unit tank)
?- q.ham
%noun
%= $
q.ham
?: ?=(@ lum)
[%mato %$]
:- %plot
|- ^- (list wine)
[%noun ?:(?=(@ +.lum) [[%mato %$] ~] $(lum +.lum))]
==
::
%path
:- ~
:+ %rose
[['/' ~] ['/' ~] ~]
|- ^- (list tank)
?~ lum ~
?@ lum !!
?> ?=(@ -.lum)
[[%leaf (rip 3 -.lum)] $(lum +.lum)]
::
%type
=+ tyr=|.((dial dole))
=+ vol=tyr(sut lum)
=+ cis=;;(tank .*(vol [%9 2 %0 1]))
:^ ~ %palm
[~ ~ ~ ~]
[[%leaf '#' 't' '/' ~] cis ~]
::
%wall
:- ~
:+ %rose
[[' ' ~] ['<' '|' ~] ['|' '>' ~]]
|- ^- (list tank)
?~ lum ~
?@ lum !!
[[%leaf (trip ;;(@ -.lum))] $(lum +.lum)]
::
%wool
:- ~
:+ %rose
[[' ' ~] ['<' '<' ~] ['>' '>' ~]]
|- ^- (list tank)
?~ lum ~
?@ lum !!
[(need ^$(q.ham %yarn, lum -.lum)) $(lum +.lum)]
::
%yarn
[~ %leaf (dash (tape lum) '"' "\{")]
::
%void
~
::
[%mato *]
?. ?=(@ lum)
~
:+ ~
%leaf
?+ (rash p.q.ham ;~(sfix (cook crip (star low)) (star hig)))
~(rend co [%$ p.q.ham lum])
%$ ~(rend co [%$ %ud lum])
%t (dash (rip 3 lum) '\'' ~)
%tas ['%' ?.(=(0 lum) (rip 3 lum) ['$' ~])]
==
::
[%gate *]
!!
::
[%core *]
:: XX needs rethinking for core metal
:: ?. ?=(^ lum) ~
:: => .(lum `*`lum)
:: =- ?~(tok ~ [~ %rose [[' ' ~] ['<' ~] ['>' ~]] u.tok])
:: ^= tok
:: |- ^- (unit (list tank))
:: ?~ p.q.ham
:: =+ den=^$(q.ham q.q.ham)
:: ?~(den ~ [~ u.den ~])
:: =+ mur=$(p.q.ham t.p.q.ham, lum +.lum)
:: ?~(mur ~ [~ [[%leaf (rip 3 i.p.q.ham)] u.mur]])
[~ (dial ham)]
::
[%face *]
=+ wal=$(q.ham q.q.ham)
?~ wal
~
[~ %palm [['=' ~] ~ ~ ~] [%leaf (trip p.q.ham)] u.wal ~]
::
[%list *]
?: =(~ lum)
[~ %leaf '~' ~]
=- ?~ tok
~
[~ %rose [[' ' ~] ['~' '[' ~] [']' ~]] u.tok]
^= tok
|- ^- (unit (list tank))
?: ?=(@ lum)
?.(=(~ lum) ~ [~ ~])
=+ [for=^$(q.ham q.q.ham, lum -.lum) aft=$(lum +.lum)]
?. &(?=(^ for) ?=(^ aft))
~
[~ u.for u.aft]
::
[%bcwt *]
|- ^- (unit tank)
?~ p.q.ham
~
=+ wal=^$(q.ham i.p.q.ham)
?~ wal
$(p.q.ham t.p.q.ham)
wal
::
[%plot *]
=- ?~ tok
~
[~ %rose [[' ' ~] ['[' ~] [']' ~]] u.tok]
^= tok
|- ^- (unit (list tank))
?~ p.q.ham
~
?: ?=([* ~] p.q.ham)
=+ wal=^$(q.ham i.p.q.ham)
?~(wal ~ [~ [u.wal ~]])
?@ lum
~
=+ gim=^$(q.ham i.p.q.ham, lum -.lum)
?~ gim
~
=+ myd=$(p.q.ham t.p.q.ham, lum +.lum)
?~ myd
~
[~ u.gim u.myd]
::
[%pear *]
?. =(lum q.q.ham)
~
=. p.q.ham
(rash p.q.ham ;~(sfix (cook crip (star low)) (star hig)))
=+ fox=$(q.ham [%mato p.q.ham])
?> ?=([~ %leaf ^] fox)
?: ?=(?(%n %tas) p.q.ham)
fox
[~ %leaf '%' p.u.fox]
::
[%stop *]
?: (~(has in gil) [p.q.ham lum]) ~
=+ kep=(~(get by p.ham) p.q.ham)
?~ kep
~|([%stop-loss p.q.ham] !!)
$(gil (~(put in gil) [p.q.ham lum]), q.ham u.kep)
::
[%tree *]
=- ?~ tok
~
[~ %rose [[' ' ~] ['{' ~] ['}' ~]] u.tok]
^= tok
=+ tuk=*(list tank)
|- ^- (unit (list tank))
?: =(~ lum)
[~ tuk]
?. ?=([n=* l=* r=*] lum)
~
=+ rol=$(lum r.lum)
?~ rol
~
=+ tim=^$(q.ham q.q.ham, lum n.lum)
?~ tim
~
$(lum l.lum, tuk [u.tim u.rol])
::
[%unit *]
?@ lum
?.(=(~ lum) ~ [~ %leaf '~' ~])
?. =(~ -.lum)
~
=+ wal=$(q.ham q.q.ham, lum +.lum)
?~ wal
~
[~ %rose [[' ' ~] ['[' ~] [']' ~]] [%leaf '~' ~] u.wal ~]
==
::
++ doge
|= ham=cape
=- ?+ woz woz
[%list * [%mato %'ta']] %path
[%list * [%mato %'t']] %wall
[%list * [%mato %'tD']] %yarn
[%list * %yarn] %wool
==
^= woz
^- wine
?. ?=([%stop *] q.ham)
?: ?& ?= [%bcwt [%pear %n %0] [%plot [%pear %n %0] [%face *] ~] ~]
q.ham
=(1 (met 3 p.i.t.p.i.t.p.q.ham))
==
[%unit =<([p q] i.t.p.i.t.p.q.ham)]
q.ham
=+ may=(~(get by p.ham) p.q.ham)
?~ may
q.ham
=+ nul=[%pear %n 0]
?. ?& ?=([%bcwt *] u.may)
?=([* * ~] p.u.may)
|(=(nul i.p.u.may) =(nul i.t.p.u.may))
==
q.ham
=+ din=?:(=(nul i.p.u.may) i.t.p.u.may i.p.u.may)
?: ?& ?=([%plot [%face *] [%face * %stop *] ~] din)
=(p.q.ham p.q.i.t.p.din)
=(1 (met 3 p.i.p.din))
=(1 (met 3 p.i.t.p.din))
==
:+ %list
(cat 3 p.i.p.din p.i.t.p.din)
q.i.p.din
?: ?& ?= $: %plot
[%face *]
[%face * %stop *]
[[%face * %stop *] ~]
==
din
=(p.q.ham p.q.i.t.p.din)
=(p.q.ham p.q.i.t.t.p.din)
=(1 (met 3 p.i.p.din))
=(1 (met 3 p.i.t.p.din))
=(1 (met 3 p.i.t.t.p.din))
==
:+ %tree
%^ cat
3
p.i.p.din
(cat 3 p.i.t.p.din p.i.t.t.p.din)
q.i.p.din
q.ham
::
++ dole
^- cape
=+ gil=*(set type)
=+ dex=[p=*(map type @) q=*(map @ wine)]
=< [q.p q]
|- ^- [p=[p=(map type @) q=(map @ wine)] q=wine]
=- [p.tez (doge q.p.tez q.tez)]
^= tez
^- [p=[p=(map type @) q=(map @ wine)] q=wine]
?: (~(meet ut sut) -:!>(*type))
[dex %type]
?- sut
%noun [dex sut]
%void [dex sut]
[%atom *] [dex ?~(q.sut [%mato p.sut] [%pear p.sut u.q.sut])]
[%cell *]
=+ hin=$(sut p.sut)
=+ yon=$(dex p.hin, sut q.sut)
:- p.yon
:- %plot
?:(?=([%plot *] q.yon) [q.hin p.q.yon] [q.hin q.yon ~])
::
[%core *]
?: ?=([[%$ * [[%$ @ *] ~ ~]] ~ ~] q.r.q.sut)
=/ dad $(sut p.sut)
:- p.dad
~! q.r.q.sut
[%gate q.n.q.q.n.q.r.q.sut sut(r.p.q %gold) q.dad]
=+ yad=$(sut p.sut)
:- p.yad
=+ ^= doy ^- [p=(list @ta) q=wine]
?: ?=([%core *] q.yad)
[p.q.yad q.q.yad]
[~ q.yad]
:- %core
:_ q.doy
:_ p.doy
%^ cat 3
%~ rent co
:+ %$ %ud
%- ~(rep by (~(run by q.r.q.sut) |=(tome ~(wyt by q.+<))))
|=([[@ a=@u] b=@u] (add a b))
%^ cat 3
?-(r.p.q.sut %gold '.', %iron '|', %lead '?', %zinc '&')
=+ gum=(mug q.r.q.sut)
%+ can 3
:~ [1 (add 'a' (mod gum 26))]
[1 (add 'a' (mod (div gum 26) 26))]
[1 (add 'a' (mod (div gum 676) 26))]
==
::
[%hint *]
$(sut q.sut)
::
[%face *]
=+ yad=$(sut q.sut)
?^(p.sut yad [p.yad [%face p.sut q.yad]])
::
[%fork *]
=+ yed=(sort ~(tap in p.sut) aor)
=- [p [%bcwt q]]
|- ^- [p=[p=(map type @) q=(map @ wine)] q=(list wine)]
?~ yed
[dex ~]
=+ mor=$(yed t.yed)
=+ dis=^$(dex p.mor, sut i.yed)
[p.dis q.dis q.mor]
::
[%hold *]
=+ hey=(~(get by p.dex) sut)
?^ hey
[dex [%stop u.hey]]
?: (~(has in gil) sut)
=+ dyr=+(~(wyt by p.dex))
[[(~(put by p.dex) sut dyr) q.dex] [%stop dyr]]
=+ rom=$(gil (~(put in gil) sut), sut ~(repo ut sut))
=+ rey=(~(get by p.p.rom) sut)
?~ rey
rom
[[p.p.rom (~(put by q.p.rom) u.rey q.rom)] [%stop u.rey]]
==
::
++ duck (dial dole)
--

301
desk/lib/language-server/json.hoon
View File

@ -1,301 +0,0 @@
/- lsp=language-server
|%
::
++ util
|%
++ get-json-string
|= [jon=(map @t json) key=@t]
^- (unit cord)
=/ cord-jon=(unit json)
(~(get by jon) key)
?~ cord-jon
~
?> ?=([%s *] u.cord-jon)
`p.u.cord-jon
--
::
::
++ dejs
=, dejs:format
|%
++ request
|= jon=json
?> ?=([%o *] jon)
=/ method=cord
%- method
(trip (need (get-json-string:util p.jon 'method')))
=/ id=cord
(need (get-json-string:util p.jon 'id'))
=/ params=json
(~(got by p.jon) 'params')
^- all:request:lsp
|^
?+ method [%unknown jon]
%text-document--hover (text-document--hover params id)
%text-document--completion (text-document--completion params id)
==
::
++ text-document--hover
|= [params=json id=cord]
^- text-document--hover:request:lsp
:+ %text-document--hover
id
%. params
%: ot
position+position
'textDocument'^text-document-id
~
==
::
++ text-document--completion
|= [params=json id=cord]
:+ %text-document--completion id
%. params
%: ot
position+position
'textDocument'^text-document-id
~
==
--
::
++ notification
|= jon=json
?> ?=([%o *] jon)
=/ method=cord
%- method
(trip (need (get-json-string:util p.jon 'method')))
=/ params=json
(~(got by p.jon) 'params')
^- all:notification:lsp
|^
?+ method [%unknown jon]
%text-document--did-change
(text-document--did-change params)
%text-document--did-open
(text-document--did-open params)
%text-document--did-save
(text-document--did-save params)
%text-document--did-close
(text-document--did-close params)
==
::
++ text-document--did-save
|= jon=json
^- text-document--did-save:notification:lsp
?> ?=([%o *] jon)
=/ doc-id
(~(got by p.jon) 'textDocument')
:- %text-document--did-save
(text-document-id doc-id)
::
++ text-document--did-close
|= jon=json
^- text-document--did-close:notification:lsp
?> ?=([%o *] jon)
=/ doc-id
(~(got by p.jon) 'textDocument')
:- %text-document--did-close
(text-document-id doc-id)
::
++ text-document--did-change
|= jon=json
^- text-document--did-change:notification:lsp
:- %text-document--did-change
%. jon
%: ot
'textDocument'^text-document-id
'contentChanges'^text-document-changes
~
==
::
++ text-document--did-open
|= jon=json
^- text-document--did-open:notification:lsp
?> ?=([%o *] jon)
:- %text-document--did-open
(text-document-item (~(got by p.jon) 'textDocument'))
--
:: Utilities
::
++ text-document-item
|= jon=json
^- text-document-item:lsp
%. jon
%: ot
uri+so
version+(mu ni)
text+so
~
==
::
++ text-document-id
%: ou
uri+(un so)
version+(uf ~ (pe ~ ni))
~
==
::
++ text-document-changes
%- ar
%: ou
range+(uf ~ (pe ~ range))
'rangeLength'^(uf ~ (pe ~ ni))
text+(un so)
~
==
::
++ method
|= =tape
^- cord
%- crip %- zing
%+ join "--"
^- (list ^tape)
%+ turn
^- (list (list ^tape))
%+ scan
tape
%+ more
fas
;~ plug
(star low)
(star ;~(plug (cook |=(a=@ (add a 32)) hig) (star low)))
==
|= words=(list ^tape)
^- ^tape
(zing (join "-" words))
::
++ range
%: ot
start+position
end+position
~
==
::
++ position
%: ot
line+ni
character+ni
~
==
--
::
++ enjs
=, enjs:format
|%
++ text-document--publish-diagnostics
|= pub=text-document--publish-diagnostics:notification:lsp
^- json
%: pairs
uri+s+uri.pub
diagnostics+a+(turn diagnostics.pub diagnostic)
~
==
++ notification
|= notification=all:notification:lsp
^- json
=/ params=json
?+ -.notification !!
%text-document--publish-diagnostics
(text-document--publish-diagnostics notification)
==
~! -.notification
=/ method=cord (crip (unparse-method -.notification))
%: pairs
method+s+method
params+params
~
==
::
++ response
|= res=all:response:lsp
^- json
|^
?- -.res
%text-document--hover (text-document--hover res)
%text-document--completion (text-document--completion res)
==
::
++ wrap-in-id
|= [id=cord res=json]
%: pairs
id+s+id
result+res
~
==
++ text-document--hover
|= hov=text-document--hover:response:lsp
%+ wrap-in-id id.hov
%+ frond 'contents'
?~ contents.hov
~
s+u.contents.hov
::
++ text-document--completion
|= com=text-document--completion:response:lsp
%+ wrap-in-id id.com
[%a (turn completion.com completion-item)]
--
++ unparse-method
|= =cord
^- ^tape
%+ rash cord
%+ cook |=(l=(list ^tape) (zing (join "/" l)))
%+ more (jest '--')
%+ cook
|= tapes=(list ^tape)
^- ^tape
?~ tapes ~
%- zing
:- i.tapes
%+ turn t.tapes
|= t=^tape
^- ^tape
?~ t ~
[`@tD`(sub i.t 32) t.t]
%+ more
;~(less (jest '--') hep)
(star alf)
::
++ completion-item
|= com=completion-item:lsp
^- json
%: pairs
label+s+label.com
detail+s+detail.com
kind+(numb kind.com)
'documentation'^s+doc.com
'insertText'^s+insert-text.com
'insertTextFormat'^(numb insert-text-format.com)
~
==
::
++ position
|= =position:lsp
^- json
%: pairs
line+(numb row.position)
character+(numb col.position)
~
==
::
++ range
|= =range:lsp
^- json
%: pairs
start+(position start.range)
end+(position end.range)
~
==
::
++ diagnostic
|= diag=diagnostic:lsp
^- json
%: pairs
range+(range range.diag)
severity+(numb severity.diag)
message+s+message.diag
~
==
::
--
--

72
desk/lib/language-server/parser.hoon
View File

@ -1,72 +0,0 @@
:: lifted directly from ford, should probably be in zuse
=, clay
=< pile-rule
|%
++ pile-rule
|= pax=path
%- full
%+ ifix
:_ gay
:: parse optional /? and ignore
::
;~(plug gay (punt ;~(plug fas wut gap dem gap)))
|^
;~ plug
%+ cook (bake zing (list (list taut)))
%+ rune hep
(most ;~(plug com gaw) taut-rule)
::
%+ cook (bake zing (list (list taut)))
%+ rune lus
(most ;~(plug com gaw) taut-rule)
::
%+ rune tis
;~(plug sym ;~(pfix gap stap))
::
%+ rune sig
;~((glue gap) sym wyde:vast stap)
::
%+ rune cen
;~(plug sym ;~(pfix gap ;~(pfix cen sym)))
::
%+ rune buc
;~ (glue gap)
sym
;~(pfix cen sym)
;~(pfix cen sym)
==
::
%+ rune tar
;~ (glue gap)
sym
;~(pfix cen sym)
stap
==
::
%+ stag %tssg
(most gap tall:(vang & pax))
==
::
++ pant
|* fel=^rule
;~(pose fel (easy ~))
::
++ mast
|* [bus=^rule fel=^rule]
;~(sfix (more bus fel) bus)
::
++ rune
|* [bus=^rule fel=^rule]
%- pant
%+ mast gap
;~(pfix fas bus gap fel)
--
::
++ taut-rule
%+ cook |=(taut +<)
;~ pose
(stag ~ ;~(pfix tar sym))
;~(plug (stag ~ sym) ;~(pfix tis sym))
(cook |=(a=term [`a a]) sym)
==
--

532
desk/lib/language-server/rune-snippet.hoon
View File

@ -1,532 +0,0 @@
/- lsp-sur=language-server
/+ auto=language-server-complete
=>
|%
++ snippet
|= [rune=tape text=tape]
^- json
=, enjs:format
%- pairs
:~ 'label'^(tape rune)
'insertTextFormat'^(numb 2)
'insertText'^(tape text)
==
::
++ runes
^- (list (option:auto tape))
:~ :- '|$'
"""
$\{1:sample}
$\{2:body}
"""
:- '|_'
"""
$\{1:sample}
++ $\{2:arm}
$\{3:body}
--
"""
:- '|:'
"""
$\{1:sample}
$\{2:body}
"""
:- '|%'
"""
++ $\{1:arm}
$\{2:body}
--
"""
:- '|.'
"""
$\{1:body}
"""
:- '|^'
"""
$\{1:body}
::
++ $\{2:arm}
$\{3:body}
--
"""
:- '|-'
"""
$\{1:body}
"""
:- '|~'
"""
$\{1:sample}
$\{2:body}
"""
:- '|*'
"""
$\{1:sample}
$\{2:body}
"""
:- '|='
"""
$\{1:sample}
$\{2:body}
"""
:- '|@'
"""
++ $\{1:arm}
$\{2:body}
--
"""
:- '|?'
"""
$\{1:sample}
"""
::
:- ':_'
"""
$\{1:tail}
$\{2:head}
"""
:- ':^'
"""
$\{1:car}
$\{2:cadr}
$\{3:caddr}
$\{4:cddr}
"""
:- ':-'
"""
$\{1:tail}
$\{2:head}
"""
:- ':+'
"""
$\{1:car}
$\{2:cadr}
$\{3:cddr}
"""
:- ':~'
"""
$\{1:item}
==
"""
:- ':*'
"""
$\{1:item}
==
"""
::
:- '%_'
"""
$\{1:target}
$\{2:wing} $\{3:new-value}
==
"""
:- '%.'
"""
$\{1:arg}
$\{2:gate}
"""
:- '%-'
"""
$\{1:gate}
$\{2:arg}
"""
:- '%:'
"""
$\{1:gate}
$\{2:args}
==
"""
:- '%*'
"""
$\{1:target-wing} $\{2:from}
$\{3:wing} $\{4:new-value}
==
"""
:- '%^'
"""
$\{1:gate}
$\{2:arg1}
$\{3:arg2}
$\{4:arg3}
"""
:- '%+'
"""
$\{1:gate}
$\{2:arg1}
$\{3:arg2}
"""
:- '%~'
"""
$\{1:arm}
$\{2:core}
$\{3:arg}
"""
:- '%='
"""
$\{1:target}
$\{2:wing} $\{3:new-value}
==
"""
::
:- '.^'
"""
$\{1:mold}
$\{2:path}
"""
:- '.+'
"""
$\{1:atom}
"""
:- '.*'
"""
$\{1:subject}
$\{2:formula}
"""
:- '.='
"""
$\{1:a}
$\{2:b}
"""
:- '.?'
"""
$\{1:noun}
"""
::
:- '^|'
"""
$\{1:iron-core}
"""
:- '^.'
"""
$\{1:a}
$\{2:b}
"""
:- '^+'
"""
$\{1:like}
$\{2:body}
"""
:- '^-'
"""
$\{1:type}
$\{2:body}
"""
:- '^&'
"""
$\{1:zinc-core}
"""
:- '^~'
"""
$\{1:constant}
"""
:- '^='
"""
$\{1:face}
$\{2:body}
"""
:- '^?'
"""
$\{1:lead-core}
"""
:- '^*'
"""
$\{1:type}
"""
:- '^:'
"""
$\{1:type}
"""
::
:- '~|'
"""
$\{1:trace}
$\{2:body}
"""
:- '~_'
"""
$\{1:tank}
$\{2:body}
"""
:- '~%'
"""
$\{1:name}
$\{2:parent}
~
$\{3:body}
"""
:- '~/'
"""
$\{1:name}
$\{2:body}
"""
:- '~<'
"""
$\{1:hint}
$\{2:body}
"""
:- '~>'
"""
$\{1:hint}
$\{2:body}
"""
:- '~$'
"""
$\{1:name}
$\{2:body}
"""
:- '~+'
"""
$\{1:body}
"""
:- '~&'
"""
$\{1:printf}
$\{2:body}
"""
:- '~='
"""
$\{1:a}
$\{2:b}
"""
:- '~?'
"""
$\{1:condition}
$\{2:printf}
$\{3:body}
"""
:- '~!'
"""
$\{1:type}
$\{2:body}
"""
::
:- ';='
"""
$\{1:manx}
==
"""
:- ';:'
"""
$\{1:gate}
$\{2:args}
==
"""
:- ';/'
"""
$\{1:tape}
"""
:- ';<'
"""
$\{1:type} bind:m $\{2:body1}
$\{3:body2}
"""
:- ';~'
"""
$\{1:gate}
$\{2:args}
==
"""
:- ';;'
"""
$\{1:type}
$\{2:body}
"""
::
:- '=|'
"""
$\{1:type}
$\{2:body}
"""
:- '=:'
"""
$\{1:wing} $\{2:value}
==
$\{3:body}
"""
:- '=/'
"""
$\{1:face}
$\{2:value}
$\{3:body}
"""
:- '=;'
"""
$\{1:face}
$\{2:body}
$\{3:value}
"""
:- '=.'
"""
$\{1:wing}
$\{2:value}
$\{3:body}
"""
:- '=?'
"""
$\{1:wing} $\{2:condition}
$\{3:value}
$\{4:body}
"""
:- '=<'
"""
$\{1:formula}
$\{2:subject}
"""
:- '=-'
"""
$\{1:body}
$\{2:value}
"""
:- '=>'
"""
$\{1:subject}
$\{2:formula}
"""
:- '=^'
"""
$\{1:face} $\{2:wing}
$\{3:computation}
$\{4:body}
"""
:- '=+'
"""
$\{1:value}
$\{2:body}
"""
:- '=~'
"""
$\{1:body}
"""
:- '=*'
"""
$\{1:alias} $\{2:value}
$\{3:body}
"""
:- '=,'
"""
$\{1:alias}
$\{3:body}
"""
::
:- '?|'
"""
$\{1:condition}
==
"""
:- '?-'
"""
$\{1:case}
$\{2:type} $\{3:value}
==
"""
:- '?:'
"""
$\{1:if}
$\{2:then}
$\{3:else}
"""
:- '?.'
"""
$\{1:if}
$\{2:else}
$\{3:then}
"""
:- '?^'
"""
$\{1:value}
$\{2:if-cell}
$\{3:if-atom}
"""
:- '?<'
"""
$\{1:assertion}
$\{2:body}
"""
:- '?>'
"""
$\{1:assertion}
$\{2:body}
"""
:- '?+'
"""
$\{1:case} $\{2:else}
$\{3:type} $\{4:value}
==
"""
:- '?&'
"""
$\{1:condition}
==
"""
:- '?@'
"""
$\{1:value}
$\{2:if-atom}
$\{3:if-cell}
"""
:- '?~'
"""
$\{1:value}
$\{2:if-null}
$\{3:if-nonnull}
"""
:- '?#'
"""
$\{1:skin}
$\{2:wing}
"""
:- '?='
"""
$\{1:type}
$\{2:wing}
"""
:- '?!'
"""
$\{1:loobean}
"""
::
:- '!,'
"""
*hoon
$\{1:ast}
"""
:- '!>'
"""
$\{1:value}
"""
:- '!;'
"""
$\{1:type}
$\{2:body}
"""
:- '!='
"""
$\{1:body}
"""
:- '!@'
"""
$\{1:wing}
$\{2:if-exists}
$\{3:if-not-exists}
"""
:- '!?'
"""
$\{1:version}
$\{2:body}
"""
:- '!!'
""
==
--
|= rune=tape
^- (list completion-item:lsp-sur)
=? rune =(' ' (snag 0 rune))
(slag 1 rune)
~& rune
%+ turn (search-prefix:auto (crip rune) runes)
|= [name=cord snippet=tape]
^- completion-item:lsp-sur
[name 1 '' '' (crip snippet) 2]

55
desk/lib/mip.hoon
View File

@ -1,55 +0,0 @@
|%
++ mip :: map of maps
|$ [kex key value]
(map kex (map key value))
::
++ bi :: mip engine
=| a=(map * (map))
|@
++ del
|* [b=* c=*]
=+ d=(~(gut by a) b ~)
=+ e=(~(del by d) c)
?~ e
(~(del by a) b)
(~(put by a) b e)
::
++ get
|* [b=* c=*]
=> .(b `_?>(?=(^ a) p.n.a)`b, c `_?>(?=(^ a) ?>(?=(^ q.n.a) p.n.q.n.a))`c)
^- (unit _?>(?=(^ a) ?>(?=(^ q.n.a) q.n.q.n.a)))
(~(get by (~(gut by a) b ~)) c)
::
++ got
|* [b=* c=*]
(need (get b c))
::
++ gut
|* [b=* c=* d=*]
(~(gut by (~(gut by a) b ~)) c d)
::
++ has
|* [b=* c=*]
!=(~ (get b c))
::
++ key
|* b=*
~(key by (~(gut by a) b ~))
::
++ put
|* [b=* c=* d=*]
%+ ~(put by a) b
%. [c d]
%~ put by
(~(gut by a) b ~)
::
++ tap
::NOTE naive turn-based implementation find-errors ):
=< $
=+ b=`_?>(?=(^ a) *(list [x=_p.n.a _?>(?=(^ q.n.a) [y=p v=q]:n.q.n.a)]))`~
|. ^+ b
?~ a
b
$(a r.a, b (welp (turn ~(tap by q.n.a) (lead p.n.a)) $(a l.a)))
--
--

309
desk/lib/ph/io.hoon
View File

@ -1,309 +0,0 @@
/- *aquarium, spider
/+ libstrand=strand, *strandio, util=ph-util, aqua-azimuth
=, strand=strand:libstrand
|%
++ send-events
|= events=(list aqua-event)
=/ m (strand ,~)
^- form:m
(poke-our %aqua %aqua-events !>(events))
::
++ send-azimuth-action
|= =azimuth-action
=/ m (strand ,~)
^- form:m
(poke-our %aqua %azimuth-action !>(azimuth-action))
::
++ take-unix-effect
=/ m (strand ,[ship unix-effect])
^- form:m
;< [=path =cage] bind:m (take-fact-prefix /effect)
?> ?=(%aqua-effect p.cage)
(pure:m !<([aqua-effect] q.cage))
::
++ start-simple
(start-test %aqua-ames %aqua-behn %aqua-dill %aqua-eyre ~)
::
++ start-azimuth
=/ m (strand ,~)
^- form:m
;<(~ bind:m start-simple init)
::
++ end
(end-test %aqua-ames %aqua-behn %aqua-dill %aqua-eyre ~)
::
++ start-test
|= vane-threads=(list term)
=/ m (strand ,~)
^- form:m
~& > "starting"
;< tids=(map term tid:spider) bind:m (start-threads vane-threads)
;< ~ bind:m (watch-our /effect %aqua /effect)
:: Get our very own event with no mistakes in it... yet.
::
:: We want to wait for the vane threads to actually start and get
:: their subscriptions started. Other ways to do this are delaying
:: the ack from spider until the build is finished (does that
:: guarantee the subscriptions have started?) or subscribe to the
:: threads themselves for a notification when they're done. This is
:: probably the best option because the thread can delay until it
:: gets a positive ack on the subscription.
::
:: Threads might not get built until a %writ is dripped back to
:: spider. Drips are at +(now), so we sleep until two clicks in the
:: future.
::
;< ~ bind:m (sleep `@dr`2)
(pure:m ~)
::
++ end-test
|= vane-threads=(list term)
=/ m (strand ,~)
^- form:m
~& > "done"
;< ~ bind:m (stop-threads vane-threads)
;< ~ bind:m (leave-our /effect %aqua)
(pure:m ~)
::
++ start-threads
|= threads=(list term)
=/ m (strand ,(map term tid:spider))
^- form:m
;< =bowl:spider bind:m get-bowl
=| tids=(map term tid:spider)
|- ^- form:m
=* loop $
?~ threads
(pure:m tids)
=/ tid
%+ scot %ta
(cat 3 (cat 3 'strand_' i.threads) (scot %uv (sham i.threads eny.bowl)))
=/ poke-vase !>([`tid.bowl ~ byk.bowl i.threads *vase])
;< ~ bind:m (poke-our %spider %spider-start poke-vase)
loop(threads t.threads, tids (~(put by tids) i.threads tid))
::
++ stop-threads
|= threads=(list term)
=/ m (strand ,~)
^- form:m
(pure:m ~)
::
::
++ init
=/ m (strand ,~)
^- form:m
(send-azimuth-action %init-azimuth ~)
::
++ spawn
|= =ship
~& > "spawning {<ship>}"
=/ m (strand ,~)
^- form:m
(send-azimuth-action %spawn ship)
::
++ breach
|= =ship
~& > "breaching {<ship>}"
=/ m (strand ,~)
^- form:m
(send-azimuth-action %breach ship)
::
:: who: breachee
:: her: wait until hears about breach
::
++ breach-and-hear
|= [who=ship her=ship]
~& > "breaching {<who>} for {<her>}"
=/ m (strand ,~)
;< =bowl:spider bind:m get-bowl
=/ aqua-pax
:- %i
/(scot %p her)/j/(scot %p her)/rift/(scot %da now.bowl)/(scot %p who)/noun
=/ old-rut ;;((unit @) (scry-aqua:util noun our.bowl now.bowl aqua-pax))
=/ new-rut
?~ old-rut
1
+(+.old-rut)
;< ~ bind:m (send-azimuth-action %breach who)
|- ^- form:m
=* loop $
;< ~ bind:m (sleep ~s10)
;< =bowl:spider bind:m get-bowl
=/ aqua-pax
:- %i
/(scot %p her)/j/(scot %p her)/rift/(scot %da now.bowl)/(scot %p who)/noun
=/ rut (scry-aqua:util noun our.bowl now.bowl aqua-pax)
?: =([~ new-rut] rut)
(pure:m ~)
loop
::
++ init-moon ::NOTE real moon always have the same keys
|= [moon=ship fake=?]
?> ?=(%earl (clan:title moon))
?: fake (init-ship moon &)
=/ m (strand ,~)
^- form:m
;< ~ bind:m
%+ dojo (^sein:title moon)
=/ =pass pub:ex:(get-keys:aqua-azimuth moon 1)
"|moon {(scow %p moon)}, =public-key {(scow %uw pass)}"
(init-ship moon |)
::
++ init-ship
|= [=ship fake=?]
=/ m (strand ,~)
^- form:m
~& > "starting {<ship>}"
;< ~ bind:m (send-events (init:util ship fake))
(check-ship-booted ship)
::
++ check-ship-booted
|= =ship
=/ m (strand ,~)
^- form:m
=* loop $
;< [her=^ship =unix-effect] bind:m take-unix-effect
=/ f |=(=tape (is-dojo-output:util ship her unix-effect tape))
:: This is a pretty bad heuristic, but in general galaxies will
:: hit the first of these cases, and other ships will hit the
:: second.
::
?: ?| (f ":dojo>")
(f "is your neighbor")
==
(pure:m ~)
loop
::
++ dojo
|= [=ship =tape]
=/ m (strand ,~)
^- form:m
~& > "dojo: {tape}"
(send-events (dojo:util ship tape))
::
++ wait-for-output
|= [=ship =tape]
=/ m (strand ,~)
^- form:m
~& > "waiting for output: {tape}"
|- ^- form:m
=* loop $
;< [her=^ship =unix-effect] bind:m take-unix-effect
?: (is-dojo-output:util ship her unix-effect tape)
(pure:m ~)
loop
::
:: Send "|hi" from one ship to another
::
++ send-hi
|= [from=@p to=@p]
=/ m (strand ,~)
^- form:m
;< ~ bind:m (dojo from "|hi {(scow %p to)}")
(wait-for-output from "hi {(scow %p to)} successful")
::
:: Send "|hi" and wait for "not responding" message
::
++ send-hi-not-responding
|= [from=@p to=@p]
~& > 'sending hi not responding'
=/ m (strand ,~)
;< ~ bind:m (dojo from "|hi {(scow %p to)}")
(wait-for-output from "{(scow %p to)} not responding still trying")
::
:: Mount a desk.
::
++ mount
|= [=ship =desk]
=/ m (strand ,~)
^- form:m
;< ~ bind:m (dojo ship "|mount /={(trip desk)}=")
|- ^- form:m
=* loop $
;< [her=^ship =unix-effect] bind:m take-unix-effect
?: (is-ergo:util ship her unix-effect)
(pure:m ~)
loop
::
:: Modify /sur/aquarium/hoon on the given ship
::
++ touch-file
|= [her=ship =desk extra=@t]
=/ m (strand ,@t)
^- form:m
(touch her desk /sur/aquarium/hoon extra)
::
:: Modify path on the given ship
::
++ touch
|= [her=ship =desk pax=path extra=@t]
=/ m (strand ,@t)
^- form:m
~& > "touching file on {<her>}/{<desk>}"
;< ~ bind:m (mount her desk)
;< our=@p bind:m get-our
;< now=@da bind:m get-time
=/ aqua-pax
;: weld
/i/(scot %p her)/cx/(scot %p her)/[desk]/(scot %da now)
pax
/noun
==
=/ warped
%^ cat 3 '=> . '
%^ cat 3 extra
(need (scry-aqua:util (unit @) our now aqua-pax))
;< ~ bind:m (send-events (insert-files:util her desk [pax warped] ~))
(pure:m warped)
::
:: Check /sur/aquarium/hoon on the given has the given contents.
::
++ check-file-touched
|= [=ship =desk warped=@t]
=/ m (strand ,~)
(check-touched ship desk /sur/aquarium/hoon warped)
::
:: Check path on the given desk has the given contents.
::
++ check-touched
|= [=ship =desk pax=path warped=@t]
=/ m (strand ,~)
~& > "checking file touched on {<ship>}/{<desk>}"
;< ~ bind:m (mount ship desk)
^- form:m
|- ^- form:m
=* loop $
;< [her=^ship =unix-effect] bind:m take-unix-effect
;< our=@p bind:m get-our
;< now=@da bind:m get-time
:: %ergo is no longer sufficient because .^ is pinned to beginning of
:: the event. So we hope somebody sets a timer for something.
::
?. &(=(ship her) ?=(?(%init %ergo %doze) -.q.unix-effect))
loop
=/ aqua-pax
;: weld
/i/(scot %p ship)/cx/(scot %p ship)/[desk]/(scot %da now)
pax
/noun
==
?: =(warped (need (scry-aqua:util (unit @) our now aqua-pax)))
(pure:m ~)
loop
::
:: Turns poke into a dojo command
::
++ poke-app
|= [=ship app=term =mark data=*]
=/ m (strand ,~)
^- form:m
=/ command=tape ":{(trip app)} &{(trip mark)} {<data>}"
(send-events (dojo:util ship command))
::
++ dojo-thread
|= [=ship ted=term =mark data=*]
=/ m (strand ,~)
^- form:m
=/ command=tape "-{(trip ted)} &{(trip mark)} {<data>}"
(send-events (dojo:util ship command))
--

112
desk/lib/ph/util.hoon
View File

@ -1,112 +0,0 @@
:: Utility functions for constructing tests
::
/- aquarium
=, aquarium
|%
::
:: Turn [ship (list unix-event)] into (list ph-event)
::
++ send-events-to
|= [who=ship what=(list unix-event)]
^- (list aqua-event)
%+ turn what
|= ue=unix-event
[%event who ue]
::
:: Start a ship (low-level; prefer +raw-ship)
::
++ init
|= [who=ship fake=?]
^- (list aqua-event)
[%init-ship who fake]~
::
:: Send dojo command
::
++ dojo
|= [who=ship what=tape]
^- (list aqua-event)
%+ send-events-to who
^- (list unix-event)
:~
[/d/term/1 %belt %ctl `@c`%e]
[/d/term/1 %belt %ctl `@c`%u]
[/d/term/1 %belt %txt ((list @c) what)]
[/d/term/1 %belt %ret ~]
==
::
:: Control character
::
++ ctrl
|= [who=ship what=term]
^- (list ph-event)
%+ send-events-to who
:~ [/d/term/1 %belt %ctl (,@c what)]
==
::
:: Inject a file into a ship
::
++ insert-files
|= [who=ship des=desk files=(list [=path txt=@t])]
^- (list aqua-event)
=/ input
%+ turn files
|= [=path txt=@t]
[path ~ /text/plain (as-octs:mimes:html txt)]
%+ send-events-to who
:~
[/c/sync/0v1n.2m9vh %into des | input]
==
::
:: Checks whether the given event is a dojo output blit containing the
:: given tape
::TODO should be rename -dill-output
++ is-dojo-output
|= [who=ship her=ship uf=unix-effect what=tape]
?& =(who her)
?=(%blit -.q.uf)
::
%+ lien p.q.uf
|= =blit:dill
?. ?=(%lin -.blit)
|
!=(~ (find what p.blit))
==
::
:: Test is successful if +is-dojo-output
::
++ expect-dojo-output
|= [who=ship her=ship uf=unix-effect what=tape]
^- (list ph-event)
?. (is-dojo-output who her uf what)
~
[%test-done &]~
::
:: Check whether the given event is an ergo
::
++ is-ergo
|= [who=ship her=ship uf=unix-effect]
?& =(who her)
?=(%ergo -.q.uf)
==
::
:: Check if given effect is an http request; extract
::
++ extract-request
|= [uf=unix-effect dest=@t]
^- (unit [num=@ud =request:http])
?. ?=(%request -.q.uf) ~
?. =(dest url.request.q.uf) ~
`[id.q.uf request.q.uf]
::
:: Scry into a running aqua ship
::
++ scry-aqua
|* [a=mold our=@p now=@da pax=path]
.^ a
%gx
(scot %p our)
%aqua
(scot %da now)
pax
==
--

138
desk/lib/pill.hoon
View File

@ -1,138 +0,0 @@
:: |pill: helper functions for making pills
::
/- dice
^?
|%
::
+$ pill
$% [%ivory p=(list)]
$: %pill
nam=term
boot-ova=(list)
kernel-ova=(list unix-event)
userspace-ova=(list unix-event)
== ==
::
+$ unix-event
%+ pair wire
$% [%wack p=@]
[%what p=(list (pair path (cask)))]
[%whom p=ship]
[%boot ? $%($>(%fake task:jael) $>(%dawn task:jael))]
[%wyrd p=vere]
[%verb p=(unit ?)]
unix-task
==
:: +boot-ovum: boostrap kernel filesystem load
::
++ boot-ovum
|= [hoon=cord arvo=cord]
:~ //arvo
%what
[/sys/hoon hoon/hoon]
[/sys/arvo hoon/arvo]
==
:: +file-ovum: userspace filesystem load
::
:: bas: full path to / directory
::
++ file-ovum
=/ directories=(list path)
:~ /app :: %gall applications
/gen :: :dojo generators
/lib :: libraries
/mar :: mark definitions
/sur :: structures
/sys :: system files
/ted :: :spider strands
/web :: %eyre web content
/desk :: desk manifest
==
|= [des=desk bas=path]
^- unix-event
%. directories
|= :: sal: all spurs to load from
::
sal=(list spur)
^- unix-event
::
:: hav: all user files
::
=; hav ~& user-files+(lent hav)
=/ =yuki:clay
:- *(list tako:clay)
%- ~(gas by *(map path (each page lobe:clay)))
(turn hav |=([=path =page] [path &+page]))
[/c/sync [%park des &+yuki *rang:clay]]
=| hav=(list [path page])
|- ^+ hav
?~ sal ~
=. hav $(sal t.sal)
::
:: tyl: spur
::
=/ tyl i.sal
|- ^+ hav
::
:: pax: full path at `tyl`
:: lon: directory at `tyl`
::
=/ lyt (flop tyl)
=/ pax (weld bas lyt)
=/ lon .^(arch %cy pax)
=? hav ?=(^ fil.lon)
:_ hav
:- lyt
?. ?=([%azimuth-snapshot *] tyl)
[mark=;;(@tas (head tyl)) noun=.^(* %cx pax)]
=; convert
mime/(convert .^(snap-state:dice %cx pax))
.^($-(snap-state:dice mime) %cf (weld bas /azimuth-snapshot/mime))
=/ all ~(tap by dir.lon)
|- ^+ hav
?~ all hav
$(all t.all, hav ^$(tyl [p.i.all tyl]))
::
:: +file-ovum2: electric boogaloo
::
++ file-ovum2 |=(p=path `unix-event`[//arvo what/(user-files p)])
::
:: +user-files: all userspace hoon files
::
++ user-files
|= bas=path
%. directories:file-ovum
|= sal=(list spur)
^- (list (pair path (cask)))
::
:: hav: all user files
::
=| hav=(list (pair path (cask)))
|- ^+ hav
?~ sal ~
=. hav $(sal t.sal)
::
:: tyl: spur
::
=/ tyl i.sal
|- ^+ hav
::
:: pax: full path at `tyl`
:: lon: directory at `tyl`
::
=/ pax (weld bas (flop tyl))
=/ lon .^(arch %cy pax)
=? hav ?=(^ fil.lon)
::
:: install only hoon files for now
::
?. ?=([%hoon *] tyl)
hav
:_ hav
[(flop `path`t.tyl) hoon/.^(@t %cx pax)]
::
=/ all ~(tap by dir.lon)
|- ^+ hav
?~ all hav
$(all t.all, hav ^$(tyl [p.i.all tyl]))
--

378
desk/lib/pkcs.hoon
View File

@ -1,378 +0,0 @@
/- asn1
/+ primitive-rsa, der
=* rsa primitive-rsa
:::: %/lib/pkcs
|%
:: +rs256: RSA signatures over a sha-256 digest
::
++ rs256
|_ k=key:rsa
:: +emsa:rs256: message digest
::
:: Padded, DER encoded sha-256 hash (EMSA-PKCS1-v1_5).
::
++ emsa
|= m=byts
=/ emlen (met 3 n.pub.k)
=/ pec=spec:asn1
:~ %seq
[%seq [%obj sha-256:obj:asn1] [%nul ~] ~]
[%oct 32 (shay wid.m dat.m)]
==
:: note: this asn.1 digest is rendered raw here, as we require
:: big-endian bytes, and the product of +en:der is little-endian
::
=/ t=(list @D) ~(ren raw:en:der pec)
=/ tlen=@ud (lent t)
?: (lth emlen (add 11 tlen))
~|(%emsa-too-short !!)
=/ ps=(list @D)
(reap (sub emlen (add 3 tlen)) 0xff)
(rep 3 (flop (weld [0x0 0x1 ps] [0x0 t])))
:: +sign:rs256: sign message
::
:: An RSA signature is the primitive decryption of the message hash.
::
++ sign
|=(m=byts (de:rsa (emsa m) k))
:: +verify:rs256: verify signature
::
:: RSA signature verification confirms that the primitive encryption
:: of the signature matches the message hash.
::
++ verify
|= [s=@ m=byts]
=((emsa m) (en:rsa s k))
--
:: |pem: generic PEM implementation (rfc7468)
::
:: PEM is the base64 encoding of DER encoded data, with BEGIN and
:: END labels indicating some type.
::
++ pem
|%
:: +en:pem: PEM encode
::
++ en
|= [lab=@t len=@ud der=@ux]
^- wain
:: XX validate label?
:- (rap 3 ['-----BEGIN ' lab '-----' ~])
=/ a (en:base64:mimes:html len `@`der)
|- ^- wain
?~ a
[(rap 3 ['-----END ' lab '-----' ~]) ~]
[(end [3 64] a) $(a (rsh [3 64] a))]
:: +de:pem: PEM decode
::
++ de
|= [lab=@t mep=wain]
^- (unit [len=@ud der=@ux])
=/ a (sub (lent mep) 2)
?~ mep ~
:: XX validate label?
?. =((rap 3 ['-----BEGIN ' lab '-----' ~]) i.mep) ~
?. =((rap 3 ['-----END ' lab '-----' ~]) (snag a t.mep)) ~
^- (unit [@ @])
(de:base64:mimes:html (rap 3 (scag a t.mep)))
--
:: |pkcs1: RSA asymmetric cryptography (rfc3447)
::
++ pkcs1
|%
:: |spec:pkcs1: ASN.1 specs for RSA keys
::
++ spec
|%
:: |en:spec:pkcs1: ASN.1 encoding for RSA keys
::
++ en
|%
:: +pass:en:spec:pkcs1: encode public key to ASN.1
::
++ pass
|= k=key:rsa
^- spec:asn1
[%seq [%int n.pub.k] [%int e.pub.k] ~]
:: +ring:en:spec:pkcs1: encode private key to ASN.1
::
++ ring
|= k=key:rsa
^- spec:asn1
~| %rsa-need-ring
?> ?=(^ sek.k)
:~ %seq
[%int 0]
[%int n.pub.k]
[%int e.pub.k]
[%int d.u.sek.k]
[%int p.u.sek.k]
[%int q.u.sek.k]
[%int (mod d.u.sek.k (dec p.u.sek.k))]
[%int (mod d.u.sek.k (dec q.u.sek.k))]
[%int (~(inv fo p.u.sek.k) q.u.sek.k)]
==
--
:: |de:spec:pkcs1: ASN.1 decoding for RSA keys
::
++ de
|%
:: +pass:de:spec:pkcs1: decode ASN.1 public key
::
++ pass
|= a=spec:asn1
^- (unit key:rsa)
?. ?=([%seq [%int *] [%int *] ~] a)
~
=* n int.i.seq.a
=* e int.i.t.seq.a
`[[n e] ~]
:: +ring:de:spec:pkcs1: decode ASN.1 private key
::
++ ring
|= a=spec:asn1
^- (unit key:rsa)
?. ?=([%seq *] a) ~
?. ?= $: [%int %0]
[%int *]
[%int *]
[%int *]
[%int *]
[%int *]
*
==
seq.a
~
=* n int.i.t.seq.a
=* e int.i.t.t.seq.a
=* d int.i.t.t.t.seq.a
=* p int.i.t.t.t.t.seq.a
=* q int.i.t.t.t.t.t.seq.a
`[[n e] `[d p q]]
--
--
:: |der:pkcs1: DER encoding for RSA keys
::
:: En(coding) and de(coding) for public (pass) and private (ring) keys.
::
++ der
|%
++ en
|%
++ pass |=(k=key:rsa (en:^der (pass:en:spec k)))
++ ring |=(k=key:rsa (en:^der (ring:en:spec k)))
--
++ de
|%
++ pass |=([len=@ud dat=@ux] `(unit key:rsa)`(biff (de:^der len dat) pass:de:spec))
++ ring |=([len=@ud dat=@ux] `(unit key:rsa)`(biff (de:^der len dat) ring:de:spec))
--
--
:: |pem:pkcs1: PEM encoding for RSA keys
::
:: En(coding) and de(coding) for public (pass) and private (ring) keys.
::
++ pem
|%
++ en
|%
++ pass |=(k=key:rsa (en:^pem 'RSA PUBLIC KEY' (pass:en:der k)))
++ ring |=(k=key:rsa (en:^pem 'RSA PRIVATE KEY' (ring:en:der k)))
--
++ de
|%
++ pass |=(mep=wain (biff (de:^pem 'RSA PUBLIC KEY' mep) pass:de:der))
++ ring |=(mep=wain (biff (de:^pem 'RSA PRIVATE KEY' mep) ring:de:der))
--
--
--
:: |pkcs8: asymmetric cryptography (rfc5208, rfc5958)
::
:: RSA-only for now.
::
++ pkcs8
|%
:: |spec:pkcs8: ASN.1 specs for asymmetric keys
::
++ spec
|%
++ en
|%
:: +pass:spec:pkcs8: public key ASN.1
::
:: Technically not part of pkcs8, but standardized later in
:: the superseding RFC. Included here for symmetry.
::
++ pass
|= k=key:rsa
^- spec:asn1
:~ %seq
[%seq [[%obj rsa:obj:asn1] [%nul ~] ~]]
=/ a=[len=@ud dat=@ux]
(pass:en:der:pkcs1 k)
[%bit (mul 8 len.a) dat.a]
==
:: +ring:spec:pkcs8: private key ASN.1
::
++ ring
|= k=key:rsa
^- spec:asn1
:~ %seq
[%int 0]
[%seq [[%obj rsa:obj:asn1] [%nul ~] ~]]
[%oct (ring:en:der:pkcs1 k)]
==
--
:: |de:spec:pkcs8: ASN.1 decoding for asymmetric keys
::
++ de
|%
:: +pass:de:spec:pkcs8: decode public key ASN.1
::
++ pass
|= a=spec:asn1
^- (unit key:rsa)
?. ?=([%seq [%seq *] [%bit *] ~] a)
~
?. ?& ?=([[%obj *] [%nul ~] ~] seq.i.seq.a)
=(rsa:obj:asn1 obj.i.seq.i.seq.a)
==
~
(pass:de:der:pkcs1 (div len.i.t.seq.a 8) bit.i.t.seq.a)
:: +ring:de:spec:pkcs8: decode private key ASN.1
::
++ ring
|= a=spec:asn1
^- (unit key:rsa)
?. ?=([%seq [%int %0] [%seq *] [%oct *] ~] a)
~
?. ?& ?=([[%obj *] [%nul ~] ~] seq.i.t.seq.a)
=(rsa:obj:asn1 obj.i.seq.i.t.seq.a)
==
~
(ring:de:der:pkcs1 [len oct]:i.t.t.seq.a)
--
--
:: |der:pkcs8: DER encoding for asymmetric keys
::
:: En(coding) and de(coding) for public (pass) and private (ring) keys.
:: RSA-only for now.
::
++ der
|%
++ en
|%
++ pass |=(k=key:rsa `[len=@ud dat=@ux]`(en:^der (pass:en:spec k)))
++ ring |=(k=key:rsa `[len=@ud dat=@ux]`(en:^der (ring:en:spec k)))
--
++ de
|%
++ pass |=([len=@ud dat=@ux] `(unit key:rsa)`(biff (de:^der len dat) pass:de:spec))
++ ring |=([len=@ud dat=@ux] `(unit key:rsa)`(biff (de:^der len dat) ring:de:spec))
--
--
:: |pem:pkcs8: PEM encoding for asymmetric keys
::
:: En(coding) and de(coding) for public (pass) and private (ring) keys.
:: RSA-only for now.
::
++ pem
|%
++ en
|%
++ pass |=(k=key:rsa (en:^pem 'PUBLIC KEY' (pass:en:der k)))
++ ring |=(k=key:rsa (en:^pem 'PRIVATE KEY' (ring:en:der k)))
--
++ de
|%
++ pass |=(mep=wain (biff (de:^pem 'PUBLIC KEY' mep) pass:de:der))
++ ring |=(mep=wain (biff (de:^pem 'PRIVATE KEY' mep) ring:de:der))
--
--
--
:: |pkcs10: certificate signing requests (rfc2986)
::
:: Only implemented for RSA keys with subject-alternate names.
::
++ pkcs10
=> |%
:: +csr:pkcs10: certificate request
::
+$ csr [key=key:rsa hot=(list turf)]
--
|%
:: |spec:pkcs10: ASN.1 specs for certificate signing requests
::
++ spec
|%
:: +en:spec:pkcs10: ASN.1 encoding for certificate signing requests
::
++ en
|= csr
^- spec:asn1
|^ =/ dat=spec:asn1 (info key hot)
:~ %seq
dat
[%seq [[%obj rsa-sha-256:obj:asn1] [%nul ~] ~]]
:: big-endian signature bits
::
:: the signature bitwidth is definitionally the key length
::
:+ %bit
(met 0 n.pub.key)
(swp 3 (~(sign rs256 key) (en:^der dat)))
==
:: +info:en:spec:pkcs10: certificate request info
::
++ info
|= csr
^- spec:asn1
:~ %seq
[%int 0]
[%seq ~]
(pass:en:spec:pkcs8 key)
:: explicit, context-specific tag #0 (extensions)
::
:+ %con
`bespoke:asn1`[| 0]
%~ ren
raw:en:^der
:~ %seq
[%obj csr-ext:obj:asn1]
:~ %set
:~ %seq
:~ %seq
[%obj sub-alt:obj:asn1]
[%oct (en:^der (san hot))]
== == == == ==
:: +san:en:spec:pkcs10: subject-alternate-names
::
++ san
|= hot=(list turf)
^- spec:asn1
:- %seq
%+ turn hot
:: implicit, context-specific tag #2 (IA5String)
:: XX sanitize string?
|=(=turf [%con `bespoke:asn1`[& 2] (trip (en-turf:html turf))])
--
:: |de:spec:pkcs10: ASN.1 decoding for certificate signing requests
++ de !!
--
:: |der:pkcs10: DER encoding for certificate signing requests
::
++ der
|%
++ en |=(a=csr `[len=@ud der=@ux]`(en:^der (en:spec a)))
++ de !! ::|=(a=@ `(unit csr)`(biff (de:^der a) de:spec))
--
:: |pem:pkcs10: PEM encoding for certificate signing requests
::
++ pem
|%
++ en |=(a=csr (en:^pem 'CERTIFICATE REQUEST' (en:der a)))
++ de !! ::|=(mep=wain (biff (de:^pem 'CERTIFICATE REQUEST' mep) de:der))
--
--
--

84
desk/lib/primitive-rsa.hoon
View File

@ -1,84 +0,0 @@
:: |rsa: primitive, textbook RSA
::
:: Unpadded, unsafe, unsuitable for encryption!
::
|%
:: +key:rsa: rsa public or private key
::
+$ key
$: :: pub: public parameters (n=modulus, e=pub-exponent)
::
pub=[n=@ux e=@ux]
:: sek: secret parameters (d=private-exponent, p/q=primes)
::
sek=(unit [d=@ux p=@ux q=@ux])
==
:: +ramp: make rabin-miller probabilistic prime
::
:: XX replace +ramp:number?
:: a: bitwidth
:: b: snags (XX small primes to check divisibility?)
:: c: entropy
::
++ ramp
|= [a=@ b=(list @) c=@]
=. c (shas %ramp c)
:: XX what is this value?
::
=| d=@
|- ^- @ux
:: XX what is this condition?
::
?: =((mul 100 a) d)
~|(%ar-ramp !!)
:: e: prime candidate
::
:: Sets low bit, as prime must be odd.
:: Sets high bit, as +raw:og only gives up to :a bits.
::
=/ e :(con 1 (lsh [0 (dec a)] 1) (~(raw og c) a))
:: XX what algorithm is this modular remainder check?
::
?: ?& (levy b |=(f=@ !=(1 (mod e f))))
(pram:number e)
==
e
$(c +(c), d (shax d))
:: +elcm:rsa: carmichael totient
::
++ elcm
|= [a=@ b=@]
(div (mul a b) d:(egcd a b))
:: +new-key:rsa: write somethingXXX
::
++ new-key
=/ e `@ux`65.537
|= [wid=@ eny=@]
^- key
=/ diw (rsh 0 wid)
=/ p=@ux (ramp diw [3 5 ~] eny)
=/ q=@ux (ramp diw [3 5 ~] +(eny))
=/ n=@ux (mul p q)
=/ d=@ux (~(inv fo (elcm (dec p) (dec q))) e)
[[n e] `[d p q]]
:: +en:rsa: primitive RSA encryption
::
:: ciphertext = message^e (mod n)
::
++ en
|= [m=@ k=key]
~| %rsa-len
?> (lte (met 0 m) (met 0 n.pub.k))
(~(exp fo n.pub.k) e.pub.k m)
:: +de:rsa: primitive RSA decryption
::
:: message = ciphertext^d (mod e)
::
++ de
|= [m=@ k=key]
:: XX assert rsa-len here too?
~| %rsa-need-ring
?> ?=(^ sek.k)
=/ fu (fu:number p.u.sek.k q.u.sek.k)
(out.fu (exp.fu d.u.sek.k (sit.fu m)))
--

478
desk/lib/ring.hoon
View File

@ -1,478 +0,0 @@
/- *ring
:: ring signatures over the edwards curve
::
|%
:: +raw is the raw internal ring signature implementation. +raw does not deal
:: with urbit ship identities or urbit nouns and is low level. It only deals
:: with ed25519 keys and message digests.
::
:: This raw interface is vaguely modeled on the haskell aos-signature package,
:: but is written in terms of ed25519 primitives instead of general ECC and
:: changes how linkage tags are computed so that how linkage occurs is a
:: client decision instead of hard coding the set of public keys as the
:: linkage scope.
::
++ raw
|%
:: +generate-public-linkage: generate public linkage information
::
++ generate-public-linkage
|= link-scope=@
^- [data=@ h=@udpoint]
::
=/ data=@ (mod link-scope l:ed:crypto)
=/ h=@udpoint (scalarmult-base:ed:crypto data)
[data h]
:: +generate-linkage: linkage information from scope and private key
::
:: data: deterministically picked data point based off scope
:: h: h = [data] * g
:: y: y = [x] * h
++ generate-linkage
|= [link-scope=(unit @) my-private-key=@]
^- (unit [data=@ h=@udpoint y=@udpoint])
::
?~ link-scope
~
::
=+ [data=@ h=@udpoint]=(generate-public-linkage u.link-scope)
=/ y=@udpoint (scalarmult:ed:crypto my-private-key h)
[~ data h y]
:: +generate-challenge: generate challenge from a given message
::
:: When :link-scope is ~ (ie, we're not building a linked ring signature),
:: calculates just the hash of `[message g]`. Otherwise, weaves the
:: linkage state into the challenge.
::
++ generate-challenge
|= $: :: common to both linked and unlinked
message=@
g=@udpoint
:: high level universal state
::
link-state=(unit [data=@ h=@udpoint y=@udpoint])
:: point to include in challenge when link-state isn't ~
::
h=(unit @udpoint)
==
^- @
:: concatenate and reduce our message down to a 512-bit hash
=/ concatenated
?~ link-state
(shal 96 (can 3 ~[[64 message] [32 g]]))
::
%+ shal 192
%+ can 3
:~ [64 message]
[32 g]
[32 data.u.link-state]
[32 y.u.link-state]
[32 (need h)]
==
::
(mod concatenated l:ed:crypto)
:: +generate-challenges: generates the full list of challenges
::
++ generate-challenges
|= $: link-state=(unit [data=@ h=@udpoint y=@udpoint])
message=@
public-keys=(list @udpoint)
ss=(list @)
::
prev-k=@u
prev-s=@
prev-ch=@
challenges=(list @)
==
^- (list @)
::
=/ gs=@udpoint
%- add-scalarmult-scalarmult-base:ed:crypto :*
prev-ch
(snag prev-k public-keys)
prev-s
==
::
=/ hs=(unit @udpoint)
?~ link-state
~
::
:- ~
%- add-double-scalarmult:ed:crypto :*
prev-s
h.u.link-state
prev-ch
y.u.link-state
==
::
=/ ch=@
(generate-challenge message gs link-state hs)
::
?~ ss
[ch challenges]
::
%_ $
prev-k (mod (add prev-k 1) (lent public-keys))
prev-s i.ss
prev-ch ch
ss t.ss
challenges [ch challenges]
==
:: +scalarmult-h: maybe multiply u by h in linkage
::
:: Since linkage tags are optional, we need to be able to just do the math
:: in case :linkage is set and fall through otherwise. +scalarmult-h is
:: used to generate the (unit point) consumed by +generate-challenge.
::
++ scalarmult-h
|= [u=@ linkage=(unit [data=@ h=@udpoint y=@udpoint])]
^- (unit @udpoint)
?~ linkage
~
[~ (scalarmult:ed:crypto u h.u.linkage)]
:: +reorder: reorders a list so the ith element is first
::
++ reorder
|* [i=@ l=(list)]
%+ weld
(slag i l)
(scag i l)
:: +sign: creates a ring signature on an ed25519 curve
::
++ sign
|= $: message=@
link-scope=(unit @)
::
anonymity-set=(set @udpoint)
my-public-key=@udpoint
my-private-key=@udscalar
::
eny=@uvJ
==
^- raw-ring-signature
|^ :: k: our public-key's position in :anonymity-list
::
=/ k=@u
~| [%couldnt-find my-public-key in=anonymity-list]
(need (find [my-public-key ~] anonymity-list))
:: Generate linkage information if given
::
=/ linkage=(unit [data=@ h=@udpoint y=@udpoint])
(generate-linkage link-scope my-private-key)
:: initialize our random number generator from entropy
::
=+ rand=~(. og eny)
:: generate the random s values used in the ring
::
=^ random-s-values=(list @) rand
=| count=@
=| random-s-values=(list @)
|-
?: =(count (sub participants 1))
[random-s-values rand]
::
=^ v=@ rand (rads:rand l:ed:crypto)
$(count (add 1 count), random-s-values [v random-s-values])
::
?> ?=(^ random-s-values)
=/ sk1=@ i.random-s-values
=/ sk2-to-prev-sk=(list @) t.random-s-values
:: Pick a random :u
::
=^ u=@ rand
(rads:rand l:ed:crypto)
:: Compute challenge at k + 1
::
=/ chk1=@
%- generate-challenge :*
message
(scalarmult-base:ed:crypto u)
linkage
(scalarmult-h u linkage)
==
:: Generate challenges for [ck, ..., c1, c0, ... ck + 2, ck + 1]
::
=/ reversed-chk-to-chk1=(list @)
%- generate-challenges :*
linkage
message
anonymity-list
sk2-to-prev-sk
::
(mod (add k 1) participants)
sk1
chk1
[chk1 ~]
==
=/ chk=@ (head reversed-chk-to-chk1)
:: Compute s = u - x * c mod n
::
=/ sk=@ (~(dif fo l:ed:crypto) u (mul my-private-key chk))
::
=/ ordered-challenges=(list @)
(order-challenges k (flop reversed-chk-to-chk1))
::
=/ ordered-ss=(list @) (order-ss k [sk sk1 sk2-to-prev-sk])
=/ ch0 (head ordered-challenges)
::
[ch0 ordered-ss ?~(linkage ~ `y.u.linkage)]
::
++ anonymity-list
~(tap in anonymity-set)
::
++ participants
(lent anonymity-list)
::
++ order-challenges
|= [k=@ ch=(list @)]
(reorder (sub participants (add k 1)) ch)
::
++ order-ss
|= [k=@ sk-to-prev-sk=(list @)]
(reorder (sub participants k) sk-to-prev-sk)
--
:: +verify: verify signature
::
++ verify
|= $: message=@
link-scope=(unit @)
::
anonymity-set=(set @udpoint)
signature=raw-ring-signature
==
^- ?
:: if there's a linkage scope but no tag, fail
::
?: &(?=(^ link-scope) ?=(~ y.signature))
%.n
:: if there's no linkage scope but a tag, fail
::
?: &(?=(~ link-scope) ?=(^ y.signature))
%.n
:: vice versa.
::
:: decompose the signature into [s0 s1 s2....]
::
?> ?=([@ @ *] s.signature)
=/ s0=@ i.s.signature
=/ s1=@ i.t.s.signature
=/ s2-to-end=(list @) t.t.s.signature
:: anonymity-list: set of public keys listified in ring order
::
=/ anonymity-list=(list @udpoint)
~(tap in anonymity-set)
:: participants: length of :anonymity-list
::
=/ participants=@u
(lent anonymity-list)
::
=/ z0p=@udpoint
%- add-scalarmult-scalarmult-base:ed:crypto :*
ch0.signature
(head anonymity-list)
s0
==
:: generate the linkage using public data, and the y point from the
:: signature
::
=/ linkage=(unit [data=@ h=@udpoint y=@udpoint])
?~ link-scope
~
=+ [data=@ h=@udpoint]=(generate-public-linkage u.link-scope)
:- ~
[data h (need y.signature)]
::
=/ z0pp=(unit @udpoint)
?~ linkage
~
:- ~
%- add-double-scalarmult:ed:crypto :*
s0
h.u.linkage
ch0.signature
y.u.linkage
==
:: initial challenge
::
=/ ch1=@
(generate-challenge message z0p linkage z0pp)
::
=/ challenges
%- generate-challenges :*
linkage
message
anonymity-list
s2-to-end
::
(mod 1 participants)
s1
ch1
[ch1 ~]
==
::
=(ch0.signature (head challenges))
--
:: +detail: details about getting keys from Azimuth
::
++ detail
|%
:: +seed-to-private-key-scalar: keyfile form to scalar we can multiply with
::
++ seed-to-private-key-scalar
|= sk=@I ^- @udscalar
?: (gth (met 3 sk) 32) !!
=+ h=(shal (rsh [0 3] b:ed:crypto) sk)
%+ add
(bex (sub b:ed:crypto 2))
(lsh [0 3] (cut 0 [3 (sub b:ed:crypto 5)] h))
:: +get-public-key-from-pass: decode the raw @ public key structure
::
++ get-public-key-from-pass
|= a=pass
^- [@ @]
=+ [mag=(end 3 a) bod=(rsh 3 a)]
~| %not-crub-pubkey ?> =('b' mag)
[cry=(rsh 8 bod) sgn=(end 8 bod)]
::
::
++ get-private-key-from-ring
|= a=ring
^- [@ @]
=+ [mag=(end 3 a) bod=(rsh 3 a)]
~| %not-crub-seckey ?> =('B' mag)
=+ [c=(rsh 8 bod) s=(end 8 bod)]
:: todo: do we puck here?
[c s]
:: +ship-life-to-pubid: fetches public key information from jael
::
++ ship-life-to-pubid
|= [our=@p now=@da ship=@p =life]
^- @udpoint
::
=/ d=[=^life =pass *]
=/ scry-path=path
:~ %j
(scot %p our)
%deed
(scot %da now)
(scot %p ship)
(scot %ud life)
==
.^([^life pass *] scry-path)
:: we have the deed which has pass, which is several numbers +cat-ed
:: together; pull out the keys
::
=/ x=[crypt=@ auth=@] (get-public-key-from-pass pass.d)
::
`@udpoint`auth.x
::
++ build-signing-participants
|= [our=@p now=@da invited=(list @p)]
^- [(set [@p life]) (set @udpoint)]
::
=| participants=(set [@p life])
=| keys=(set @udpoint)
::
|-
?~ invited
[participants keys]
::
=/ lyfe=(unit @ud)
.^((unit @ud) j+/(scot %p our)/lyfe/(scot %da now)/(scot %p i.invited))
::
?~ lyfe
$(invited t.invited)
::
=/ pubkey=@udpoint (ship-life-to-pubid our now i.invited u.lyfe)
::
=. participants (~(put in participants) [i.invited u.lyfe])
=. keys (~(put in keys) pubkey)
::
$(invited t.invited)
::
::
++ build-verifying-participants
|= [our=@p now=@da invited=(list [ship=@p =life])]
^- (set @udpoint)
::
=| keys=(set @udpoint)
::
|-
?~ invited
keys
::
=/ pubkey=@udpoint
(ship-life-to-pubid our now ship.i.invited life.i.invited)
=. keys
(~(put in keys) pubkey)
::
$(invited t.invited)
--
--
:: public interface
::
|%
:: +sign: ring-signs a message using the current ship
::
++ sign
|= $: our=@p
now=@da
eny=@uvJ
::
message=*
link-scope=(unit *)
anonymity-set=(set @p)
==
^- ring-signature
:: if our is not in @p, we must be in @p.
::
=. anonymity-set (~(put in anonymity-set) our)
::
=/ msg-hash=@ (shaz (jam message))
=/ link-hash=(unit @) (bind link-scope |=(a=* (shaz (jam a))))
:: get everyone's public keys
::
=/ p=[participants=(set [ship=@p =life]) keys=(set @udpoint)]
(build-signing-participants:detail our now ~(tap in anonymity-set))
:: get our ships' current life
::
=/ our-life=life
.^(life %j /(scot %p our)/life/(scot %da now)/(scot %p our))
:: get our ships' secret keyfile ring
::
=/ secret-ring=ring
.^(ring %j /(scot %p our)/vein/(scot %da now)/(scot %ud our-life))
:: fetch the encoded auth seed from the ring
::
=/ secret-auth-seed=@
+:(get-private-key-from-ring:detail secret-ring)
:: get our ships' public key
::
=/ public-key=@udpoint
(ship-life-to-pubid:detail our now our our-life)
::
:- participants.p
:- link-scope
%- sign:raw :*
msg-hash
link-hash
keys.p
public-key
(seed-to-private-key-scalar:detail secret-auth-seed)
eny
==
:: +verify: verifies a message against a ring signature
::
++ verify
|= [our=@p now=@da message=* =ring-signature]
^- ?
::
=/ keys=(set @udpoint)
%^ build-verifying-participants:detail our now
~(tap in participants.ring-signature)
::
=/ msg-hash=@ (shaz (jam message))
=/ link-hash=(unit @) (bind link-scope.ring-signature |=(a=* (shaz (jam a))))
::
(verify:raw msg-hash link-hash keys raw.ring-signature)
--

159
desk/lib/server.hoon
View File

@ -1,159 +0,0 @@
=, eyre
|%
+$ request-line
$: [ext=(unit @ta) site=(list @t)]
args=(list [key=@t value=@t])
==
:: +parse-request-line: take a cord and parse out a url
::
++ parse-request-line
|= url=@t
^- request-line
(fall (rush url ;~(plug apat:de-purl:html yque:de-purl:html)) [[~ ~] ~])
::
++ manx-to-octs
|= man=manx
^- octs
(as-octt:mimes:html (en-xml:html man))
::
++ json-to-octs
|= jon=json
^- octs
(as-octt:mimes:html (en-json:html jon))
::
++ app
|%
::
:: +require-authorization:
:: redirect to the login page when unauthenticated
:: otherwise call handler on inbound request
::
++ require-authorization
|= $: =inbound-request:eyre
handler=$-(inbound-request:eyre simple-payload:http)
==
^- simple-payload:http
::
?: authenticated.inbound-request
~! this
~! +:*handler
(handler inbound-request)
::
=- [[307 ['location' -]~] ~]
%^ cat 3
'/~/login?redirect='
url.request.inbound-request
::
:: +require-authorization-simple:
:: redirect to the login page when unauthenticated
:: otherwise pass through simple-paylod
::
++ require-authorization-simple
|= [=inbound-request:eyre =simple-payload:http]
^- simple-payload:http
::
?: authenticated.inbound-request
~! this
simple-payload
::
=- [[307 ['location' -]~] ~]
%^ cat 3
'/~/login?redirect='
url.request.inbound-request
::
++ give-simple-payload
|= [eyre-id=@ta =simple-payload:http]
^- (list card:agent:gall)
=/ header-cage
[%http-response-header !>(response-header.simple-payload)]
=/ data-cage
[%http-response-data !>(data.simple-payload)]
:~ [%give %fact ~[/http-response/[eyre-id]] header-cage]
[%give %fact ~[/http-response/[eyre-id]] data-cage]
[%give %kick ~[/http-response/[eyre-id]] ~]
==
--
++ gen
|%
::
++ max-1-da ['cache-control' 'max-age=86400']
++ max-1-wk ['cache-control' 'max-age=604800']
::
++ html-response
=| cache=?
|= =octs
^- simple-payload:http
:_ `octs
[200 [['content-type' 'text/html'] ?:(cache [max-1-wk ~] ~)]]
::
++ css-response
=| cache=?
|= =octs
^- simple-payload:http
:_ `octs
[200 [['content-type' 'text/css'] ?:(cache [max-1-wk ~] ~)]]
::
++ js-response
=| cache=?
|= =octs
^- simple-payload:http
:_ `octs
[200 [['content-type' 'text/javascript'] ?:(cache [max-1-wk ~] ~)]]
::
++ png-response
=| cache=?
|= =octs
^- 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
^- simple-payload:http
[[200 [['content-type' 'image/x-icon'] max-1-wk ~]] `octs]
::
++ woff2-response
=| cache=?
|= =octs
^- simple-payload:http
[[200 [['content-type' 'font/woff2'] max-1-wk ~]] `octs]
::
++ json-response
=| cache=_|
|= =json
^- simple-payload:http
:_ `(json-to-octs json)
[200 [['content-type' 'application/json'] ?:(cache [max-1-da ~] ~)]]
::
++ manx-response
=| cache=_|
|= man=manx
^- simple-payload:http
:_ `(manx-to-octs man)
[200 [['content-type' 'text/html'] ?:(cache [max-1-da ~] ~)]]
::
++ not-found
^- simple-payload:http
[[404 ~] ~]
::
++ login-redirect
|= =request:http
^- simple-payload:http
=- [[307 ['location' -]~] ~]
%^ cat 3
'/~/login?redirect='
url.request
::
++ redirect
|= redirect=cord
^- simple-payload:http
[[307 ['location' redirect]~] ~]
--
--

532
desk/lib/shoe.hoon
View File

@ -1,532 +0,0 @@
:: shoe: console application library
::
:: /lib/sole: draw some characters
:: /lib/shoe: draw the rest of the fscking app
::
:: call +agent with a type, then call the resulting function with a core
:: of the shape described in +shoe.
:: you may produce classic gall cards and "shoe-effects", shorthands for
:: sending cli events to connected clients.
:: default implementations for the shoe-specific arms are in +default.
:: for a simple usage example, see /app/shoe.
::
/- *sole
/+ sole, auto=language-server-complete
|%
+$ state-0
$: %0
soles=(map @ta sole-share)
==
:: $card: standard gall cards plus shoe effects
::
+$ card
$% card:agent:gall
[%shoe sole-ids=(list @ta) effect=shoe-effect] :: ~ sends to all soles
==
:: $shoe-effect: easier sole-effects
::
+$ shoe-effect
$% :: %sole: raw sole-effect
::
[%sole effect=sole-effect]
:: %table: sortable, filterable data, with suggested column char widths
::
[%table head=(list dime) wide=(list @ud) rows=(list (list dime))]
:: %row: line sections with suggested char widths
::
[%row wide=(list @ud) cols=(list dime)]
==
:: +shoe: gall agent core with extra arms
::
++ shoe
|* command-type=mold
$_ ^|
|_ bowl:gall
:: +command-parser: input parser for a specific session
::
:: if the head of the result is true, instantly run the command
::
++ command-parser
|~ sole-id=@ta
|~(nail *(like [? command-type]))
:: +tab-list: autocomplete options for the session (to match +command-parser)
::
++ tab-list
|~ sole-id=@ta
:: (list [@t tank])
*(list (option:auto tank))
:: +on-command: called when a valid command is run
::
++ on-command
|~ [sole-id=@ta command=command-type]
*(quip card _^|(..on-init))
::
++ can-connect
|~ sole-id=@ta
*?
::
++ on-connect
|~ sole-id=@ta
*(quip card _^|(..on-init))
::
++ on-disconnect
|~ sole-id=@ta
*(quip card _^|(..on-init))
::
::NOTE standard gall agent arms below, though they may produce %shoe cards
::
++ on-init
*(quip card _^|(..on-init))
::
++ on-save
*vase
::
++ on-load
|~ vase
*(quip card _^|(..on-init))
::
++ on-poke
|~ [mark vase]
*(quip card _^|(..on-init))
::
++ on-watch
|~ path
*(quip card _^|(..on-init))
::
++ on-leave
|~ path
*(quip card _^|(..on-init))
::
++ on-peek
|~ path
*(unit (unit cage))
::
++ on-agent
|~ [wire sign:agent:gall]
*(quip card _^|(..on-init))
::
++ on-arvo
|~ [wire sign-arvo]
*(quip card _^|(..on-init))
::
++ on-fail
|~ [term tang]
*(quip card _^|(..on-init))
--
:: +default: bare-minimum implementations of shoe arms
::
++ default
|* [shoe=* command-type=mold]
|_ =bowl:gall
++ command-parser
|= sole-id=@ta
(easy *[? command-type])
::
++ tab-list
|= sole-id=@ta
~
::
++ on-command
|= [sole-id=@ta command=command-type]
[~ shoe]
::
++ can-connect
|= sole-id=@ta
(team:title [our src]:bowl)
::
++ on-connect
|= sole-id=@ta
[~ shoe]
::
++ on-disconnect
|= sole-id=@ta
[~ shoe]
--
:: +agent: creates wrapper core that handles sole events and calls shoe arms
::
++ agent
|* command-type=mold
|= =(shoe command-type)
=| state-0
=* state -
^- agent:gall
=>
|%
++ deal
|= cards=(list card)
%+ turn cards
|= =card
^- card:agent:gall
?. ?=(%shoe -.card) card
?- -.effect.card
%sole
=- [%give %fact - %sole-effect !>(effect.effect.card)]
%+ turn
?^ sole-ids.card sole-ids.card
~(tap in ~(key by soles))
|= sole-id=@ta
/sole/[sole-id]
::
%table
=; fez=(list sole-effect)
$(effect.card [%sole %mor fez])
=, +.effect.card
:- (row:draw & wide head)
%+ turn rows
(cury (cury row:draw |) wide)
::
%row
$(effect.card [%sole (row:draw | +.effect.card)])
==
--
::
|_ =bowl:gall
+* this .
og ~(. shoe bowl)
::
++ on-init
^- (quip card:agent:gall agent:gall)
=^ cards shoe on-init:og
[(deal cards) this]
::
++ on-save !>([%shoe-app on-save:og state])
::
++ on-load
|= old-state=vase
^- (quip card:agent:gall agent:gall)
:: we could be upgrading from a shoe-less app, in which case the vase
:: contains inner application state instead of our +on-save.
:: to distinguish between the two, we check for the presence of our own
:: +on-save tag in the vase.
::
?. ?=([%shoe-app ^] q.old-state)
=^ cards shoe (on-load:og old-state)
[(deal cards) this]
=^ old-inner state +:!<([%shoe-app vase state-0] old-state)
=^ cards shoe (on-load:og old-inner)
[(deal cards) this]
::
++ on-poke
|= [=mark =vase]
^- (quip card:agent:gall agent:gall)
?. ?=(%sole-action mark)
=^ cards shoe (on-poke:og mark vase)
[(deal cards) this]
::
=/ act !<(sole-action vase)
=* sole-id id.act
=/ cli-state=sole-share
(~(gut by soles) sole-id *sole-share)
|^ =^ [cards=(list card) =_cli-state] shoe
?- -.dat.act
%det (apply-edit +.dat.act)
%clr [[~ cli-state] shoe]
%ret try-command
%tab [(tab +.dat.act) shoe]
==
:- (deal cards)
this(soles (~(put by soles) sole-id cli-state))
::
++ effect
|= =sole-effect
^- card
[%shoe [sole-id]~ %sole sole-effect]
::
++ apply-edit
|= =sole-change
^+ [[*(list card) cli-state] shoe]
=^ inverse cli-state
(~(transceive sole cli-state) sole-change)
:: res: & for fully parsed, | for parsing failure at location
::
=/ res=(each (unit [run=? cmd=command-type]) @ud)
%+ rose (tufa buf.cli-state)
(command-parser:og sole-id)
?: ?=(%& -.res)
:: only auto-run eligible commands if they were typed out
:: (that is, not retrieved from command history)
::
?. &(?=(^ p.res) run.u.p.res !?=(%set -.ted.sole-change))
[[~ cli-state] shoe]
(run-command cmd.u.p.res)
:_ shoe
:: parsing failed
::
?. &(?=(%del -.inverse) =(+(p.inverse) (lent buf.cli-state)))
:: if edit was somewhere in the middle, let it happen anyway
::
[~ cli-state]
:: if edit was insertion at buffer tail, revert it
::
=^ undo cli-state
(~(transmit sole cli-state) inverse)
:_ cli-state
:_ ~
%+ effect %mor
:~ [%det undo] :: undo edit
[%err p.res] :: cursor to error location
==
::
++ try-command
^+ [[*(list card) cli-state] shoe]
=/ res=(unit [? cmd=command-type])
%+ rust (tufa buf.cli-state)
(command-parser:og sole-id)
?^ res (run-command cmd.u.res)
[[[(effect %bel ~)]~ cli-state] shoe]
::
++ run-command
|= cmd=command-type
^+ [[*(list card) cli-state] shoe]
=^ cards shoe (on-command:og sole-id cmd)
:: clear buffer
::
=^ clear cli-state (~(transmit sole cli-state) [%set ~])
=- [[[- cards] cli-state] shoe]
%+ effect %mor
:~ [%nex ~]
[%det clear]
==
::
++ tab
|= pos=@ud
^- (quip card _cli-state)
=+ (get-id-cord:auto pos (tufa buf.cli-state))
=/ needle=term
(fall id %$)
:: autocomplete empty command iff user at start of command
::
=/ options=(list (option:auto tank))
(search-prefix:auto needle (tab-list:og sole-id))
=/ advance=term
(longest-match:auto options)
=/ to-send=tape
%- trip
(rsh [3 (met 3 needle)] advance)
=/ send-pos=@ud
%+ add pos
(met 3 (fall forward ''))
=| cards=(list card)
:: only render the option list if we couldn't complete anything
::
=? cards &(?=(~ to-send) ?=(^ options))
[(effect %tab options) cards]
|- ^- (quip card _cli-state)
?~ to-send
[(flop cards) cli-state]
=^ char cli-state
(~(transmit sole cli-state) [%ins send-pos `@c`i.to-send])
%_ $
cards [(effect %det char) cards]
send-pos +(send-pos)
to-send t.to-send
==
--
::
++ on-watch
|= =path
^- (quip card:agent:gall agent:gall)
?. ?=([%sole @ ~] path)
=^ cards shoe
(on-watch:og path)
[(deal cards) this]
=* sole-id i.t.path
?> (can-connect:og sole-id)
=. soles (~(put by soles) sole-id *sole-share)
=^ cards shoe
(on-connect:og sole-id)
:_ this
%- deal
:_ cards
[%shoe [sole-id]~ %sole %pro & dap.bowl "> "]
::
++ on-leave
|= =path
^- (quip card:agent:gall agent:gall)
=^ cards shoe (on-leave:og path)
[(deal cards) this]
::
++ on-peek
|= =path
^- (unit (unit cage))
?. =(/x/dbug/state path) (on-peek:og path)
``noun+(slop on-save:og !>(shoe=state))
::
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card:agent:gall agent:gall)
=^ cards shoe (on-agent:og wire sign)
[(deal cards) this]
::
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card:agent:gall agent:gall)
=^ cards shoe (on-arvo:og wire sign-arvo)
[(deal cards) this]
::
++ on-fail
|= [=term =tang]
^- (quip card:agent:gall agent:gall)
=^ cards shoe (on-fail:og term tang)
[(deal cards) this]
--
::
++ draw
|%
++ row
|= [bold=? wide=(list @ud) cols=(list dime)]
^- sole-effect
:- %mor
^- (list sole-effect)
=/ cows=(list [wid=@ud col=dime])
%- head
%^ spin cols wide
|= [col=dime wiz=(list @ud)]
~| [%too-few-wide col]
?> ?=(^ wiz)
[[i.wiz col] t.wiz]
=/ cobs=(list [wid=@ud (list tape)])
(turn cows col-as-lines)
=+ [lin=0 any=|]
=| fez=(list sole-effect)
|- ^+ fez
=; out=tape
:: done when we're past the end of all columns
::
?: (levy out (cury test ' '))
(flop fez)
=; fec=sole-effect
$(lin +(lin), fez [fec fez])
?. bold txt+out
klr+[[`%br ~ ~]^[(crip out)]~]~
%+ roll cobs
|= [[wid=@ud lines=(list tape)] out=tape]
%+ weld out
%+ weld ?~(out "" " ")
=+ l=(swag [lin 1] lines)
?^(l i.l (reap wid ' '))
::
++ col-as-lines
|= [wid=@ud col=dime]
^- [@ud (list tape)]
:- wid
%+ turn
(break wid (col-as-text col) (break-sets -.col))
(cury (cury pad wid) (alignment -.col))
::
++ col-as-text
|= col=dime
^- tape
?+ p.col (scow col)
%t (trip q.col)
%tas ['%' (scow col)]
==
::
++ alignment
|= wut=@ta
^- ?(%left %right)
?: ?=(?(%t %ta %tas %da) wut)
%left
%right
::
++ break-sets
|= wut=@ta
:: for: may break directly before these characters
:: aft: may break directly after these characters
:: new: always break on these characters, consuming them
::
^- [for=(set @t) aft=(set @t) new=(set @t)]
?+ wut [(sy " ") (sy ".:-/") (sy "\0a")]
?(%p %q) [(sy "-") (sy "-") ~]
%ux [(sy ".") ~ ~]
==
::
++ break
|= [wid=@ud cot=tape brs=_*break-sets]
^- (list tape)
~| [wid cot]
?: =("" cot) ~
=; [lin=tape rem=tape]
[lin $(cot rem)]
:: take snip of max width+1, search for breakpoint on that.
:: we grab one char extra, to look-ahead for for.brs.
:: later on, we always transfer _at least_ the extra char.
::
=^ lin=tape cot
[(scag +(wid) cot) (slag +(wid) cot)]
=+ len=(lent lin)
:: find the first newline character
::
=/ new=(unit @ud)
=+ new=~(tap in new.brs)
=| las=(unit @ud)
|-
?~ new las
$(new t.new, las (hunt lth las (find [i.new]~ lin)))
:: if we found a newline, break on it
::
?^ new
:- (scag u.new lin)
(weld (slag +(u.new) lin) cot)
:: if it fits, we're done
::
?: (lte len wid)
[lin cot]
=+ nil=(flop lin)
:: search for latest aft match
::
=/ aft=(unit @ud)
:: exclude the look-ahead character from search
::
=. len (dec len)
=. nil (slag 1 nil)
=- ?~(- ~ `+(u.-))
^- (unit @ud)
=+ aft=~(tap in aft.brs)
=| las=(unit @ud)
|-
?~ aft (bind las (cury sub (dec len)))
$(aft t.aft, las (hunt lth las (find [i.aft]~ nil)))
:: search for latest for match
::
=/ for=(unit @ud)
=+ for=~(tap in for.brs)
=| las=(unit @ud)
|-
?~ for (bind las (cury sub (dec len)))
=- $(for t.for, las (hunt lth las -))
=+ (find [i.for]~ nil)
:: don't break before the first character
::
?:(=(`(dec len) -) ~ -)
:: if any result, break as late as possible
::
=+ brk=(hunt gth aft for)
?~ brk
:: lin can't break, produce it in its entirety
:: (after moving the look-ahead character back)
::
:- (scag wid lin)
(weld (slag wid lin) cot)
:- (scag u.brk lin)
=. cot (weld (slag u.brk lin) cot)
:: eat any leading whitespace the next line might have, "clean break"
::
|- ^+ cot
?~ cot ~
?. ?=(?(%' ' %'\09') i.cot)
cot
$(cot t.cot)
::
++ pad
|= [wid=@ud lyn=?(%left %right) lin=tape]
^+ lin
=+ l=(lent lin)
?: (gte l wid) lin
=+ p=(reap (sub wid l) ' ')
?- lyn
%left (weld lin p)
%right (weld p lin)
==
--
--

51
desk/lib/skeleton.hoon
View File

@ -1,51 +0,0 @@
:: Similar to default-agent except crashes everywhere
^- agent:gall
|_ bowl:gall
++ on-init
^- (quip card:agent:gall agent:gall)
!!
::
++ on-save
^- vase
!!
::
++ on-load
|~ old-state=vase
^- (quip card:agent:gall agent:gall)
!!
::
++ on-poke
|~ in-poke-data=cage
^- (quip card:agent:gall agent:gall)
!!
::
++ on-watch
|~ path
^- (quip card:agent:gall agent:gall)
!!
::
++ on-leave
|~ path
^- (quip card:agent:gall agent:gall)
!!
::
++ on-peek
|~ path
^- (unit (unit cage))
!!
::
++ on-agent
|~ [wire sign:agent:gall]
^- (quip card:agent:gall agent:gall)
!!
::
++ on-arvo
|~ [wire =sign-arvo]
^- (quip card:agent:gall agent:gall)
!!
::
++ on-fail
|~ [term tang]
^- (quip card:agent:gall agent:gall)
!!
--

139
desk/lib/sole.hoon
View File

@ -1,139 +0,0 @@
::
:::: /hoon/sole/lib
::
/? 310
/- *sole
::::
::
|_ sole-share :: shared-state engine
++ abet +<
++ apply
|= ted=sole-edit
^+ +>
?- -.ted
%del +>.$(buf (weld (scag p.ted buf) (slag +(p.ted) buf)))
%ins +>.$(buf (weld (scag p.ted buf) `_buf`[q.ted (slag p.ted buf)]))
%mor |- ^+ +>.^$
?~ p.ted
+>.^$
$(p.ted t.p.ted, +>.^$ ^$(ted i.p.ted))
%nop +>.$
%set +>.$(buf p.ted)
==
::
::::
:: ++transmute: symmetric operational transformation.
::
:: for any sole state +>, obeys
::
:: =+ [x=(transmute a b) y=(transmute b a)]
:: .= (apply:(apply a) x)
:: (apply:(apply b) y)
::
++ transmute :: dex as after sin
|= [sin=sole-edit dex=sole-edit]
~| [%transmute sin dex]
^- sole-edit
?: ?=(%mor -.sin)
|- ^- sole-edit
?~ p.sin dex
$(p.sin t.p.sin, dex ^$(sin i.p.sin))
::
?: ?=(%mor -.dex)
:- %mor
|- ^- (list sole-edit)
?~ p.dex ~
[^$(dex i.p.dex) $(p.dex t.p.dex)]
::
?: |(?=(%nop -.sin) ?=(%nop -.dex)) dex
?: ?=(%set -.sin) [%nop ~]
?: ?=(%set -.dex) dex
::
?- -.sin
%del
?- -.dex
%del ?: =(p.sin p.dex) [%nop ~]
?:((lth p.sin p.dex) dex(p (dec p.dex)) dex)
%ins ?:((lth p.sin p.dex) dex(p (dec p.dex)) dex)
==
::
%ins
?- -.dex
%del ?:((lte p.sin p.dex) dex(p +(p.dex)) dex)
%ins ?: =(p.sin p.dex)
?:((lth q.sin q.dex) dex dex(p +(p.dex)))
?:((lte p.sin p.dex) dex(p +(p.dex)) dex)
==
==
::
++ commit :: local change
|= ted=sole-edit
^- sole-share
abet:(apply(own.ven +(own.ven), leg [ted leg]) ted)
::
::::
:: ++inverse: inverse of change in context.
::
:: for any sole state +>, obeys
::
:: =(+> (apply:(apply a) (inverse a)))
::
++ inverse :: relative inverse
|= ted=sole-edit
^- sole-edit
=. ted ?.(?=([%mor * ~] ted) ted i.p.ted)
?- -.ted
%del [%ins p.ted (snag p.ted buf)]
%ins [%del p.ted]
%mor :- %mor
%- flop
|- ^- (list sole-edit)
?~ p.ted ~
:- ^$(ted i.p.ted)
$(p.ted t.p.ted, +>.^$ (apply i.p.ted))
%nop [%nop ~]
%set [%set buf]
==
::
++ receive :: naturalize event
|= sole-change
^- [sole-edit sole-share]
?. &(=(his.ler his.ven) (lte own.ler own.ven))
~| [%receive-sync his+[his.ler his.ven] own+[own.ler own.ven]]
!!
?> &(=(his.ler his.ven) (lte own.ler own.ven))
?> |(!=(own.ler own.ven) =(`@`0 haw) =(haw (sham buf)))
=. leg (scag (sub own.ven own.ler) leg)
:: ~? !=(own.ler own.ven) [%miss-leg leg]
=+ dat=(transmute [%mor leg] ted)
:: ~? !=(~ leg) [%transmute from+ted to+dat ~]
[dat abet:(apply(his.ven +(his.ven)) dat)]
::
++ remit :: conditional accept
|= [cal=sole-change ask=$-((list @c) ?)]
^- [(unit sole-change) sole-share]
=+ old=buf
=^ dat +>+<.$ (receive cal)
?: (ask buf)
[~ +>+<.$]
=^ lic +>+<.$ (transmit (inverse(buf old) dat))
[`lic +>+<.$]
::
++ transmit :: outgoing change
|= ted=sole-edit
^- [sole-change sole-share]
[[[his.ven own.ven] (sham buf) ted] (commit ted)]
::
++ transceive :: receive and invert
|= sole-change
^- [sole-edit sole-share]
=+ old=buf
=^ dat +>+<.$ (receive +<.$)
[(inverse(buf old) dat) +>+<.$]
::
++ transpose :: adjust position
|= pos=@ud
=+ dat=(transmute [%mor leg] [%ins pos `@c`0])
?> ?=(%ins -.dat)
p.dat
--

1
desk/lib/strand.hoon
View File

@ -1 +0,0 @@
rand

760
desk/lib/strandio.hoon
View File

@ -1,760 +0,0 @@
/- spider
/+ libstrand=strand
=, strand=strand:libstrand
=, strand-fail=strand-fail:libstrand
|%
++ send-raw-cards
|= cards=(list =card:agent:gall)
=/ m (strand ,~)
^- form:m
|= strand-input:strand
[cards %done ~]
::
++ send-raw-card
|= =card:agent:gall
=/ m (strand ,~)
^- form:m
(send-raw-cards card ~)
::
++ ignore
|= tin=strand-input:strand
`[%fail %ignore ~]
::
++ get-bowl
=/ m (strand ,bowl:strand)
^- form:m
|= tin=strand-input:strand
`[%done bowl.tin]
::
++ get-beak
=/ m (strand ,beak)
^- form:m
|= tin=strand-input:strand
`[%done [our q.byk da+now]:bowl.tin]
::
++ get-time
=/ m (strand ,@da)
^- form:m
|= tin=strand-input:strand
`[%done now.bowl.tin]
::
++ get-our
=/ m (strand ,ship)
^- form:m
|= tin=strand-input:strand
`[%done our.bowl.tin]
::
++ get-entropy
=/ m (strand ,@uvJ)
^- form:m
|= tin=strand-input:strand
`[%done eny.bowl.tin]
::
:: Convert skips to %ignore failures.
::
:: This tells the main loop to try the next handler.
::
++ handle
|* a=mold
=/ m (strand ,a)
|= =form:m
^- form:m
|= tin=strand-input:strand
=/ res (form tin)
=? next.res ?=(%skip -.next.res)
[%fail %ignore ~]
res
::
:: Wait for a poke with a particular mark
::
++ take-poke
|= =mark
=/ m (strand ,vase)
^- form:m
|= tin=strand-input:strand
?+ in.tin `[%skip ~]
~ `[%wait ~]
[~ %poke @ *]
?. =(mark p.cage.u.in.tin)
`[%skip ~]
`[%done q.cage.u.in.tin]
==
::
::
::
++ take-sign-arvo
=/ m (strand ,[wire sign-arvo])
^- form:m
|= tin=strand-input:strand
?+ in.tin `[%skip ~]
~ `[%wait ~]
[~ %sign *]
`[%done [wire sign-arvo]:u.in.tin]
==
::
:: Wait for a subscription update on a wire
::
++ take-fact-prefix
|= =wire
=/ m (strand ,[path cage])
^- form:m
|= tin=strand-input:strand
?+ in.tin `[%skip ~]
~ `[%wait ~]
[~ %agent * %fact *]
?. =(watch+wire (scag +((lent wire)) wire.u.in.tin))
`[%skip ~]
`[%done (slag (lent wire) wire.u.in.tin) cage.sign.u.in.tin]
==
::
:: Wait for a subscription update on a wire
::
++ take-fact
|= =wire
=/ m (strand ,cage)
^- form:m
|= tin=strand-input:strand
?+ in.tin `[%skip ~]
~ `[%wait ~]
[~ %agent * %fact *]
?. =(watch+wire wire.u.in.tin)
`[%skip ~]
`[%done cage.sign.u.in.tin]
==
::
:: Wait for a subscription close
::
++ take-kick
|= =wire
=/ m (strand ,~)
^- form:m
|= tin=strand-input:strand
?+ in.tin `[%skip ~]
~ `[%wait ~]
[~ %agent * %kick *]
?. =(watch+wire wire.u.in.tin)
`[%skip ~]
`[%done ~]
==
::
++ echo
=/ m (strand ,~)
^- form:m
%- (main-loop ,~)
:~ |= ~
^- form:m
;< =vase bind:m ((handle ,vase) (take-poke %echo))
=/ message=tape !<(tape vase)
%- (slog leaf+"{message}..." ~)
;< ~ bind:m (sleep ~s2)
%- (slog leaf+"{message}.." ~)
(pure:m ~)
::
|= ~
^- form:m
;< =vase bind:m ((handle ,vase) (take-poke %over))
%- (slog leaf+"over..." ~)
(pure:m ~)
==
::
++ take-watch
=/ m (strand ,path)
|= tin=strand-input:strand
?+ in.tin `[%skip ~]
~ `[%wait ~]
[~ %watch *]
`[%done path.u.in.tin]
==
::
++ take-wake
|= until=(unit @da)
=/ m (strand ,~)
^- form:m
|= tin=strand-input:strand
?+ in.tin `[%skip ~]
~ `[%wait ~]
[~ %sign [%wait @ ~] %behn %wake *]
?. |(?=(~ until) =(`u.until (slaw %da i.t.wire.u.in.tin)))
`[%skip ~]
?~ error.sign-arvo.u.in.tin
`[%done ~]
`[%fail %timer-error u.error.sign-arvo.u.in.tin]
==
::
++ take-poke-ack
|= =wire
=/ m (strand ,~)
^- form:m
|= tin=strand-input:strand
?+ in.tin `[%skip ~]
~ `[%wait ~]
[~ %agent * %poke-ack *]
?. =(wire wire.u.in.tin)
`[%skip ~]
?~ p.sign.u.in.tin
`[%done ~]
`[%fail %poke-fail u.p.sign.u.in.tin]
==
::
++ take-watch-ack
|= =wire
=/ m (strand ,~)
^- form:m
|= tin=strand-input:strand
?+ in.tin `[%skip ~]
~ `[%wait ~]
[~ %agent * %watch-ack *]
?. =(watch+wire wire.u.in.tin)
`[%skip ~]
?~ p.sign.u.in.tin
`[%done ~]
`[%fail %watch-ack-fail u.p.sign.u.in.tin]
==
::
++ poke
|= [=dock =cage]
=/ m (strand ,~)
^- form:m
=/ =card:agent:gall [%pass /poke %agent dock %poke cage]
;< ~ bind:m (send-raw-card card)
(take-poke-ack /poke)
::
++ raw-poke
|= [=dock =cage]
=/ m (strand ,~)
^- form:m
=/ =card:agent:gall [%pass /poke %agent dock %poke cage]
;< ~ bind:m (send-raw-card card)
=/ m (strand ,~)
^- form:m
|= tin=strand-input:strand
?+ in.tin `[%skip ~]
~
`[%wait ~]
::
[~ %agent * %poke-ack *]
?. =(/poke wire.u.in.tin)
`[%skip ~]
`[%done ~]
==
::
++ raw-poke-our
|= [app=term =cage]
=/ m (strand ,~)
^- form:m
;< =bowl:spider bind:m get-bowl
(raw-poke [our.bowl app] cage)
::
++ poke-our
|= [=term =cage]
=/ m (strand ,~)
^- form:m
;< our=@p bind:m get-our
(poke [our term] cage)
::
++ watch
|= [=wire =dock =path]
=/ m (strand ,~)
^- form:m
=/ =card:agent:gall [%pass watch+wire %agent dock %watch path]
;< ~ bind:m (send-raw-card card)
(take-watch-ack wire)
::
++ watch-one
|= [=wire =dock =path]
=/ m (strand ,cage)
^- form:m
;< ~ bind:m (watch wire dock path)
;< =cage bind:m (take-fact wire)
;< ~ bind:m (take-kick wire)
(pure:m cage)
::
++ watch-our
|= [=wire =term =path]
=/ m (strand ,~)
^- form:m
;< our=@p bind:m get-our
(watch wire [our term] path)
::
++ scry
|* [=mold =path]
=/ m (strand ,mold)
^- form:m
?> ?=(^ path)
?> ?=(^ t.path)
;< =bowl:spider bind:m get-bowl
%- pure:m
.^(mold i.path (scot %p our.bowl) i.t.path (scot %da now.bowl) t.t.path)
::
++ leave
|= [=wire =dock]
=/ m (strand ,~)
^- form:m
=/ =card:agent:gall [%pass watch+wire %agent dock %leave ~]
(send-raw-card card)
::
++ leave-our
|= [=wire =term]
=/ m (strand ,~)
^- form:m
;< our=@p bind:m get-our
(leave wire [our term])
::
++ rewatch
|= [=wire =dock =path]
=/ m (strand ,~)
;< ~ bind:m ((handle ,~) (take-kick wire))
;< ~ bind:m (flog-text "rewatching {<dock>} {<path>}")
;< ~ bind:m (watch wire dock path)
(pure:m ~)
::
++ wait
|= until=@da
=/ m (strand ,~)
^- form:m
;< ~ bind:m (send-wait until)
(take-wake `until)
::
++ sleep
|= for=@dr
=/ m (strand ,~)
^- form:m
;< now=@da bind:m get-time
(wait (add now for))
::
++ send-wait
|= until=@da
=/ m (strand ,~)
^- form:m
=/ =card:agent:gall
[%pass /wait/(scot %da until) %arvo %b %wait until]
(send-raw-card card)
::
++ map-err
|* computation-result=mold
=/ m (strand ,computation-result)
|= [f=$-([term tang] [term tang]) computation=form:m]
^- form:m
|= tin=strand-input:strand
=* loop $
=/ c-res (computation tin)
?: ?=(%cont -.next.c-res)
c-res(self.next ..loop(computation self.next.c-res))
?. ?=(%fail -.next.c-res)
c-res
c-res(err.next (f err.next.c-res))
::
++ set-timeout
|* computation-result=mold
=/ m (strand ,computation-result)
|= [time=@dr computation=form:m]
^- form:m
;< now=@da bind:m get-time
=/ when (add now time)
=/ =card:agent:gall
[%pass /timeout/(scot %da when) %arvo %b %wait when]
;< ~ bind:m (send-raw-card card)
|= tin=strand-input:strand
=* loop $
?: ?& ?=([~ %sign [%timeout @ ~] %behn %wake *] in.tin)
=((scot %da when) i.t.wire.u.in.tin)
==
`[%fail %timeout ~]
=/ c-res (computation tin)
?: ?=(%cont -.next.c-res)
c-res(self.next ..loop(computation self.next.c-res))
?: ?=(%done -.next.c-res)
=/ =card:agent:gall
[%pass /timeout/(scot %da when) %arvo %b %rest when]
c-res(cards [card cards.c-res])
c-res
::
++ send-request
|= =request:http
=/ m (strand ,~)
^- form:m
(send-raw-card %pass /request %arvo %i %request request *outbound-config:iris)
::
++ send-cancel-request
=/ m (strand ,~)
^- form:m
(send-raw-card %pass /request %arvo %i %cancel-request ~)
::
++ take-client-response
=/ m (strand ,client-response:iris)
^- form:m
|= tin=strand-input:strand
?+ in.tin `[%skip ~]
~ `[%wait ~]
::
[~ %sign [%request ~] %iris %http-response %cancel *]
::NOTE iris does not (yet?) retry after cancel, so it means failure
:- ~
:+ %fail
%http-request-cancelled
['http request was cancelled by the runtime']~
::
[~ %sign [%request ~] %iris %http-response %finished *]
`[%done client-response.sign-arvo.u.in.tin]
==
::
:: Wait until we get an HTTP response or cancelation and unset contract
::
++ take-maybe-sigh
=/ m (strand ,(unit httr:eyre))
^- form:m
;< rep=(unit client-response:iris) bind:m
take-maybe-response
?~ rep
(pure:m ~)
:: XX s/b impossible
::
?. ?=(%finished -.u.rep)
(pure:m ~)
(pure:m (some (to-httr:iris +.u.rep)))
::
++ take-maybe-response
=/ m (strand ,(unit client-response:iris))
^- form:m
|= tin=strand-input:strand
?+ in.tin `[%skip ~]
~ `[%wait ~]
[~ %sign [%request ~] %iris %http-response %cancel *]
`[%done ~]
[~ %sign [%request ~] %iris %http-response %finished *]
`[%done `client-response.sign-arvo.u.in.tin]
==
::
++ extract-body
|= =client-response:iris
=/ m (strand ,cord)
^- form:m
?> ?=(%finished -.client-response)
%- pure:m
?~ full-file.client-response ''
q.data.u.full-file.client-response
::
++ fetch-cord
|= url=tape
=/ m (strand ,cord)
^- form:m
=/ =request:http [%'GET' (crip url) ~ ~]
;< ~ bind:m (send-request request)
;< =client-response:iris bind:m take-client-response
(extract-body client-response)
::
++ fetch-json
|= url=tape
=/ m (strand ,json)
^- form:m
;< =cord bind:m (fetch-cord url)
=/ json=(unit json) (de-json:html cord)
?~ json
(strand-fail %json-parse-error ~)
(pure:m u.json)
::
++ hiss-request
|= =hiss:eyre
=/ m (strand ,(unit httr:eyre))
^- form:m
;< ~ bind:m (send-request (hiss-to-request:html hiss))
take-maybe-sigh
::
:: +build-file: build the source file at the specified $beam
::
++ build-file
|= [[=ship =desk =case] =spur]
=* arg +<
=/ m (strand ,(unit vase))
^- form:m
;< =riot:clay bind:m
(warp ship desk ~ %sing %a case spur)
?~ riot
(pure:m ~)
?> =(%vase p.r.u.riot)
(pure:m (some !<(vase q.r.u.riot)))
:: +build-mark: build a mark definition to a $dais
::
++ build-mark
|= [[=ship =desk =case] mak=mark]
=* arg +<
=/ m (strand ,dais:clay)
^- form:m
;< =riot:clay bind:m
(warp ship desk ~ %sing %b case /[mak])
?~ riot
(strand-fail %build-mark >arg< ~)
?> =(%dais p.r.u.riot)
(pure:m !<(dais:clay q.r.u.riot))
:: +build-tube: build a mark conversion gate ($tube)
::
++ build-tube
|= [[=ship =desk =case] =mars:clay]
=* arg +<
=/ m (strand ,tube:clay)
^- form:m
;< =riot:clay bind:m
(warp ship desk ~ %sing %c case /[a.mars]/[b.mars])
?~ riot
(strand-fail %build-tube >arg< ~)
?> =(%tube p.r.u.riot)
(pure:m !<(tube:clay q.r.u.riot))
::
:: +build-nave: build a mark definition to a $nave
::
++ build-nave
|= [[=ship =desk =case] mak=mark]
=* arg +<
=/ m (strand ,vase)
^- form:m
;< =riot:clay bind:m
(warp ship desk ~ %sing %e case /[mak])
?~ riot
(strand-fail %build-nave >arg< ~)
?> =(%nave p.r.u.riot)
(pure:m q.r.u.riot)
:: +build-cast: build a mark conversion gate (static)
::
++ build-cast
|= [[=ship =desk =case] =mars:clay]
=* arg +<
=/ m (strand ,vase)
^- form:m
;< =riot:clay bind:m
(warp ship desk ~ %sing %f case /[a.mars]/[b.mars])
?~ riot
(strand-fail %build-cast >arg< ~)
?> =(%cast p.r.u.riot)
(pure:m q.r.u.riot)
::
:: Read from Clay
::
++ warp
|= [=ship =riff:clay]
=/ m (strand ,riot:clay)
;< ~ bind:m (send-raw-card %pass /warp %arvo %c %warp ship riff)
(take-writ /warp)
::
++ read-file
|= [[=ship =desk =case:clay] =spur]
=* arg +<
=/ m (strand ,cage)
;< =riot:clay bind:m (warp ship desk ~ %sing %x case spur)
?~ riot
(strand-fail %read-file >arg< ~)
(pure:m r.u.riot)
::
++ check-for-file
|= [[=ship =desk =case:clay] =spur]
=/ m (strand ,?)
;< =riot:clay bind:m (warp ship desk ~ %sing %x case spur)
(pure:m ?=(^ riot))
::
++ list-tree
|= [[=ship =desk =case:clay] =spur]
=* arg +<
=/ m (strand ,(list path))
;< =riot:clay bind:m (warp ship desk ~ %sing %t case spur)
?~ riot
(strand-fail %list-tree >arg< ~)
(pure:m !<((list path) q.r.u.riot))
::
:: Take Clay read result
::
++ take-writ
|= =wire
=/ m (strand ,riot:clay)
^- form:m
|= tin=strand-input:strand
?+ in.tin `[%skip ~]
~ `[%wait ~]
[~ %sign * ?(%behn %clay) %writ *]
?. =(wire wire.u.in.tin)
`[%skip ~]
`[%done +>.sign-arvo.u.in.tin]
==
:: +check-online: require that peer respond before timeout
::
++ check-online
|= [who=ship lag=@dr]
=/ m (strand ,~)
^- form:m
%+ (map-err ,~) |=(* [%offline *tang])
%+ (set-timeout ,~) lag
;< ~ bind:m
(poke [who %hood] %helm-hi !>(~))
(pure:m ~)
::
:: Queue on skip, try next on fail %ignore
::
++ main-loop
|* a=mold
=/ m (strand ,~)
=/ m-a (strand ,a)
=| queue=(qeu (unit input:strand))
=| active=(unit [in=(unit input:strand) =form:m-a forms=(list $-(a form:m-a))])
=| state=a
|= forms=(lest $-(a form:m-a))
^- form:m
|= tin=strand-input:strand
=* top `form:m`..$
=. queue (~(put to queue) in.tin)
|^ (continue bowl.tin)
::
++ continue
|= =bowl:strand
^- output:m
?> =(~ active)
?: =(~ queue)
`[%cont top]
=^ in=(unit input:strand) queue ~(get to queue)
^- output:m
=. active `[in (i.forms state) t.forms]
^- output:m
(run bowl in)
::
++ run
^- form:m
|= tin=strand-input:strand
^- output:m
?> ?=(^ active)
=/ res (form.u.active tin)
=/ =output:m
?- -.next.res
%wait `[%wait ~]
%skip `[%cont ..$(queue (~(put to queue) in.tin))]
%cont `[%cont ..$(active `[in.u.active self.next.res forms.u.active])]
%done (continue(active ~, state value.next.res) bowl.tin)
%fail
?: &(?=(^ forms.u.active) ?=(%ignore p.err.next.res))
%= $
active `[in.u.active (i.forms.u.active state) t.forms.u.active]
in.tin in.u.active
==
`[%fail err.next.res]
==
[(weld cards.res cards.output) next.output]
--
::
++ retry
|* result=mold
|= [crash-after=(unit @ud) computation=_*form:(strand (unit result))]
=/ m (strand ,result)
=| try=@ud
|- ^- form:m
=* loop $
?: =(crash-after `try)
(strand-fail %retry-too-many ~)
;< ~ bind:m (backoff try ~m1)
;< res=(unit result) bind:m computation
?^ res
(pure:m u.res)
loop(try +(try))
::
++ backoff
|= [try=@ud limit=@dr]
=/ m (strand ,~)
^- form:m
;< eny=@uvJ bind:m get-entropy
%- sleep
%+ min limit
?: =(0 try) ~s0
%+ add
(mul ~s1 (bex (dec try)))
(mul ~s0..0001 (~(rad og eny) 1.000))
::
:: ----
::
:: Output
::
++ flog
|= =flog:dill
=/ m (strand ,~)
^- form:m
(send-raw-card %pass / %arvo %d %flog flog)
::
++ flog-text
|= =tape
=/ m (strand ,~)
^- form:m
(flog %text tape)
::
++ flog-tang
|= =tang
=/ m (strand ,~)
^- form:m
=/ =wall
(zing (turn (flop tang) (cury wash [0 80])))
|- ^- form:m
=* loop $
?~ wall
(pure:m ~)
;< ~ bind:m (flog-text i.wall)
loop(wall t.wall)
::
++ trace
|= =tang
=/ m (strand ,~)
^- form:m
(pure:m ((slog tang) ~))
::
++ app-message
|= [app=term =cord =tang]
=/ m (strand ,~)
^- form:m
=/ msg=tape :(weld (trip app) ": " (trip cord))
;< ~ bind:m (flog-text msg)
(flog-tang tang)
::
:: ----
::
:: Handle domains
::
++ install-domain
|= =turf
=/ m (strand ,~)
^- form:m
(send-raw-card %pass / %arvo %e %rule %turf %put turf)
::
:: ----
::
:: Threads
::
++ start-thread
|= file=term
=/ m (strand ,tid:spider)
;< =bowl:spider bind:m get-bowl
(start-thread-with-args byk.bowl file *vase)
::
++ start-thread-with-args
|= [=beak file=term args=vase]
=/ m (strand ,tid:spider)
^- form:m
;< =bowl:spider bind:m get-bowl
=/ tid
(scot %ta (cat 3 (cat 3 'strand_' file) (scot %uv (sham file eny.bowl))))
=/ poke-vase !>(`start-args:spider`[`tid.bowl `tid beak file args])
;< ~ bind:m (poke-our %spider %spider-start poke-vase)
;< ~ bind:m (sleep ~s0) :: wait for thread to start
(pure:m tid)
::
+$ thread-result
(each vase [term tang])
::
++ await-thread
|= [file=term args=vase]
=/ m (strand ,thread-result)
^- form:m
;< =bowl:spider bind:m get-bowl
=/ tid (scot %ta (cat 3 'strand_' (scot %uv (sham file eny.bowl))))
=/ poke-vase !>(`start-args:spider`[`tid.bowl `tid byk.bowl file args])
;< ~ bind:m (watch-our /awaiting/[tid] %spider /thread-result/[tid])
;< ~ bind:m (poke-our %spider %spider-start poke-vase)
;< ~ bind:m (sleep ~s0) :: wait for thread to start
;< =cage bind:m (take-fact /awaiting/[tid])
;< ~ bind:m (take-kick /awaiting/[tid])
?+ p.cage ~|([%strange-thread-result p.cage file tid] !!)
%thread-done (pure:m %& q.cage)
%thread-fail (pure:m %| ;;([term tang] q.q.cage))
==
--

82
desk/lib/test.hoon
View File

@ -1,82 +0,0 @@
:: testing utilities meant to be directly used from files in %/tests
::
|%
:: +expect-eq: compares :expected and :actual and pretty-prints the result
::
++ expect-eq
|= [expected=vase actual=vase]
^- tang
::
=| result=tang
::
=? result !=(q.expected q.actual)
%+ weld result
^- tang
:~ [%palm [": " ~ ~ ~] [leaf+"expected" (sell expected) ~]]
[%palm [": " ~ ~ ~] [leaf+"actual " (sell actual) ~]]
==
::
=? result !(~(nest ut p.actual) | p.expected)
%+ weld result
^- tang
:~ :+ %palm [": " ~ ~ ~]
:~ [%leaf "failed to nest"]
(~(dunk ut p.actual) %actual)
(~(dunk ut p.expected) %expected)
== ==
result
:: +expect: compares :actual to %.y and pretty-prints anything else
::
++ expect
|= actual=vase
(expect-eq !>(%.y) actual)
:: +expect-fail: kicks a trap, expecting crash. pretty-prints if succeeds
::
++ expect-fail
|= a=(trap)
^- tang
=/ b (mule a)
?- -.b
%| ~
%& ['expected failure - succeeded' ~]
==
:: +expect-runs: kicks a trap, expecting success; returns trace on failure
::
++ expect-success
|= a=(trap)
^- tang
=/ b (mule a)
?- -.b
%& ~
%| ['expected success - failed' p.b]
==
:: $a-test-chain: a sequence of tests to be run
::
:: NB: arms shouldn't start with `test-` so that `-test % ~` runs
::
+$ a-test-chain
$_
|?
?: =(0 0)
[%& p=*tang]
[%| p=[tang=*tang next=^?(..$)]]
:: +run-chain: run a sequence of tests, stopping at first failure
::
++ run-chain
|= seq=a-test-chain
^- tang
=/ res $:seq
?- -.res
%& p.res
%| ?. =(~ tang.p.res)
tang.p.res
$(seq next.p.res)
==
:: +category: prepends a name to an error result; passes successes unchanged
::
++ category
|= [a=tape b=tang] ^- tang
?: =(~ b) ~ :: test OK
:- leaf+"in: '{a}'"
(turn b |=(c=tank rose+[~ " " ~]^~[c]))
--

105
desk/lib/verb.hoon
View File

@ -1,105 +0,0 @@
:: Print what your agent is doing.
::
/- verb
::
|= [loud=? =agent:gall]
=| bowl-print=_|
^- agent:gall
|^ !.
|_ =bowl:gall
+* this .
ag ~(. agent bowl)
::
++ on-init
^- (quip card:agent:gall agent:gall)
%- (print bowl |.("{<dap.bowl>}: on-init"))
=^ cards agent on-init:ag
[[(emit-event %on-init ~) cards] this]
::
++ on-save
^- vase
%- (print bowl |.("{<dap.bowl>}: on-save"))
on-save:ag
::
++ on-load
|= old-state=vase
^- (quip card:agent:gall agent:gall)
%- (print bowl |.("{<dap.bowl>}: on-load"))
=^ cards agent (on-load:ag old-state)
[[(emit-event %on-load ~) cards] this]
::
++ on-poke
|= [=mark =vase]
^- (quip card:agent:gall agent:gall)
%- (print bowl |.("{<dap.bowl>}: on-poke with mark {<mark>}"))
?: ?=(%verb mark)
?- !<(?(%loud %bowl) vase)
%loud `this(loud !loud)
%bowl `this(bowl-print !bowl-print)
==
=^ cards agent (on-poke:ag mark vase)
[[(emit-event %on-poke mark) cards] this]
::
++ on-watch
|= =path
^- (quip card:agent:gall agent:gall)
%- (print bowl |.("{<dap.bowl>}: on-watch on path {<path>}"))
=^ cards agent
?: ?=([%verb %events ~] path)
[~ agent]
(on-watch:ag path)
[[(emit-event %on-watch path) cards] this]
::
++ on-leave
|= =path
^- (quip card:agent:gall agent:gall)
%- (print bowl |.("{<dap.bowl>}: on-leave on path {<path>}"))
?: ?=([%verb %event ~] path)
[~ this]
=^ cards agent (on-leave:ag path)
[[(emit-event %on-leave path) cards] this]
::
++ on-peek
|= =path
^- (unit (unit cage))
%- (print bowl |.("{<dap.bowl>}: on-peek on path {<path>}"))
(on-peek:ag path)
::
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card:agent:gall agent:gall)
%- (print bowl |.("{<dap.bowl>}: on-agent on wire {<wire>}, {<-.sign>}"))
=^ cards agent (on-agent:ag wire sign)
[[(emit-event %on-agent wire -.sign) cards] this]
::
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card:agent:gall agent:gall)
%- %+ print bowl |.
"{<dap.bowl>}: on-arvo on wire {<wire>}, {<[- +<]:sign-arvo>}"
=^ cards agent (on-arvo:ag wire sign-arvo)
[[(emit-event %on-arvo wire [- +<]:sign-arvo) cards] this]
::
++ on-fail
|= [=term =tang]
^- (quip card:agent:gall agent:gall)
%- (print bowl |.("{<dap.bowl>}: on-fail with term {<term>}"))
=^ cards agent (on-fail:ag term tang)
[[(emit-event %on-fail term) cards] this]
--
::
++ print
|= [=bowl:gall render=(trap tape)]
^+ same
=? . bowl-print
%- (slog >bowl< ~)
.
?. loud same
%- (slog [%leaf $:render] ~)
same
::
++ emit-event
|= =event:verb
^- card:agent:gall
[%give %fact ~[/verb/events] %verb-event !>(event)]
--

29
desk/mar/belt.hoon
View File

@ -1,29 +0,0 @@
:: belt: runtime belt structure
::
|_ =belt:dill
++ grad %noun
:: +grab: convert from
::
++ grab
|%
++ noun belt:dill
++ json
^- $-(^json belt:dill)
=, dejs:format
%- of
:~ aro+(su (perk %d %l %r %u ~))
bac+ul
ctl+(cu taft so)
del+ul
met+(cu taft so)
ret+ul
txt+(ar (cu taft so))
==
--
:: +grow: convert to
::
++ grow
|%
++ noun belt
--
--

34
desk/mar/bill.hoon
View File

@ -1,34 +0,0 @@
|_ bil=(list dude:gall)
++ grow
|%
++ mime `^mime`[/text/x-bill (as-octs:mimes:html hoon)]
++ noun bil
++ hoon
^- @t
|^ (crip (of-wall:format (wrap-lines (spit-duz bil))))
::
++ wrap-lines
|= taz=wall
^- wall
?~ taz ["~"]~
:- (weld ":~ " i.taz)
%- snoc :_ "=="
(turn t.taz |=(t=tape (weld " " t)))
::
++ spit-duz
|= duz=(list dude:gall)
^- wall
(turn duz |=(=dude:gall ['%' (trip dude)]))
--
++ txt (to-wain:format hoon)
--
++ grab
|%
++ noun (list dude:gall)
++ mime
|= [=mite len=@ud tex=@]
~_ tex
!<((list dude:gall) (slap !>(~) (ream tex)))
--
++ grad %noun
--

61
desk/mar/blit.hoon
View File

@ -1,61 +0,0 @@
:: blit: runtime blit structure
::
|_ =blit:dill
++ grad %noun
:: +grab: convert from
::
++ grab
|%
++ noun blit:dill
--
:: +grow: convert to
::
++ grow
|%
++ noun blit
++ json
^- ^json
=, enjs:format
%+ frond -.blit
?- -.blit
%bel b+&
%clr b+&
%hop (numb p.blit)
%lin a+(turn p.blit |=(c=@c s+(tuft c)))
%mor b+&
%url s+p.blit
::
%sag
%- pairs
:~ 'path'^(path p.blit)
'file'^s+(en:base64:mimes:html (as-octs:mimes:html (jam q.blit)))
==
::
%sav
%- pairs
:~ 'path'^(path p.blit)
'file'^s+(en:base64:mimes:html (as-octs:mimes:html q.blit))
==
::
%klr
:- %a
%+ turn p.blit
|= [=stye text=(list @c)]
%- pairs
:~ 'text'^a+(turn text |=(c=@c s+(tuft c)))
::
:- 'stye'
%- pairs
|^ :~ 'back'^(color p.q.stye)
'fore'^(color q.q.stye)
'deco'^a+(turn ~(tap in p.stye) |=(d=deco ?~(d ~ s+d)))
==
++ color
|= =tint
?@ tint ?~(tint ~ s+tint)
s+(crip ((x-co:co 6) (rep 3 ~[b g r]:tint)))
--
==
==
--
--

21
desk/mar/css.hoon
View File

@ -1,21 +0,0 @@
::
:::: /hoon/css/mar
::
/? 310
=, eyre
=, mimes:html
|_ mud=@t
++ grow :: convert to
|% ++ mime [/text/css (as-octs mud)] :: convert to %mime
++ elem ;style :: convert to %hymn
;- (trip mud)
==
++ hymn ;html:(head:"{elem}" body)
--
++ grab
|% :: convert from
++ mime |=([p=mite q=octs] (@t q.q))
++ noun @t :: clam from %noun
--
++ grad %mime
--

49
desk/mar/hoon.hoon
View File

@ -1,49 +0,0 @@
:::: /hoon/hoon/mar
::
/? 310
::
=, eyre
|_ own=@t
::
++ grow :: convert to
|%
++ mime `^mime`[/text/x-hoon (as-octs:mimes:html own)] :: convert to %mime
++ elem :: convert to %html
;div:pre(urb_codemirror "", mode "hoon"):"{(trip own)}"
:: =+ gen-id="src-{<`@ui`(mug own)>}"
:: ;div
:: ;textarea(id "{gen-id}"):"{(trip own)}"
:: ;script:"""
:: CodeMirror.fromTextArea(
:: window[{<gen-id>}],
:: \{lineNumbers:true, readOnly:true}
:: )
:: """
:: ==
++ hymn
:: ;html:(head:title:"Source" "+{elem}")
;html
;head
;title:"Source"
;script@"//cdnjs.cloudflare.com/ajax/libs/codemirror/4.3.0/codemirror.js";
;script@"/lib/syntax/hoon.js";
;link(rel "stylesheet", href "//cdnjs.cloudflare.com/ajax/libs/".
"codemirror/4.3.0/codemirror.min.css");
;link/"/lib/syntax/codemirror.css"(rel "stylesheet");
==
;body
;textarea#src:"{(trip own)}"
;script:'CodeMirror.fromTextArea(src, {lineNumbers:true, readOnly:true})'
==
==
++ txt
(to-wain:format own)
--
++ grab
|% :: convert from
++ mime |=([p=mite q=octs] q.q)
++ noun @t :: clam from %noun
++ txt of-wain:format
--
++ grad %txt
--

15
desk/mar/htm.hoon
View File

@ -1,15 +0,0 @@
::
:::: /hoon/htm/mar
::
/? 310
|_ own=manx
::
++ grad %noun
++ grow :: convert to
|%
++ noun own
++ hymn own
--
++ grab |% :: convert from
++ noun manx :: clam from %noun
-- --

22
desk/mar/html.hoon
View File

@ -1,22 +0,0 @@
::
:::: /hoon/html/mar
::
/? 310
::
:::: compute
::
=, html
|_ htm=@t
++ grow :: convert to
^?
|% ::
++ mime [/text/html (met 3 htm) htm] :: to %mime
++ hymn (need (de-xml htm)) :: to %hymn
-- ::
++ grab ^?
|% :: convert from
++ noun @t :: clam from %noun
++ mime |=([p=mite q=octs] q.q) :: retrieve form %mime
--
++ grad %mime
--

25
desk/mar/httr.hoon
View File

@ -1,25 +0,0 @@
::
:::: /hoon/httr/mar
::
/? 310
::
=, eyre
=, format
=, html
|_ hit=httr
++ grad %noun
++ grow |% ++ wall (turn wain trip)
++ wain (to-wain cord)
++ json (need (de-json cord))
++ cord q:octs
++ noun hit
++ octs
~| hit
?> =(2 (div p.hit 100))
(need r.hit)
--
++ grab :: convert from
|%
++ noun httr :: clam from %noun
--
--

17
desk/mar/hymn.hoon
View File

@ -1,17 +0,0 @@
::
:::: /hoon/hymn/mar
::
/? 310
=, mimes:html
=, html
|_ own=manx
::
++ grad %noun
++ grow :: convert to
|%
++ html (crip (en-xml own)) :: convert to %html
++ mime [/text/html (as-octs html)] :: convert to %mime
--
++ grab |% :: convert from
++ noun manx :: clam from %noun
-- --

22
desk/mar/js.hoon
View File

@ -1,22 +0,0 @@
::
:::: /hoon/js/mar
::
/? 310
::
=, eyre
|_ mud=@
++ grow
|%
++ mime [/application/javascript (as-octs:mimes:html (@t mud))]
++ elem ;script
;- (trip (@t mud))
==
++ hymn ;html:(head:"+{elem}" body)
--
++ grab
|% :: convert from
++ mime |=([p=mite q=octs] (@t q.q))
++ noun cord :: clam from %noun
--
++ grad %mime
--

26
desk/mar/json.hoon
View File

@ -1,26 +0,0 @@
::
:::: /hoon/json/mar
::
/? 310
::
:::: compute
::
=, eyre
=, format
=, html
|_ jon=json
::
++ grow :: convert to
|%
++ mime [/application/json (as-octs:mimes -:txt)] :: convert to %mime
++ txt [(crip (en-json jon))]~
--
++ grab
|% :: convert from
++ mime |=([p=mite q=octs] (fall (rush (@t q.q) apex:de-json) *json))
++ noun json :: clam from %noun
++ numb numb:enjs
++ time time:enjs
--
++ grad %mime
--

43
desk/mar/json/rpc/response.hoon
View File

@ -1,43 +0,0 @@
::
/- *json-rpc
::
|_ res=response
::
++ grad %noun
++ grow
|%
++ noun res
--
++ grab :: convert from
|%
++ noun response :: from noun
++ httr :: from httr
|= hit=httr:eyre
^- response
~| hit
?: ?=(%2 (div p.hit 100))
=, html
%- json
?~ r.hit
a+~
(need (de-json q:u.r.hit))
fail+hit
++ json :: from json
=, dejs-soft:format
|= a=json
^- response
=; dere
=+ res=((ar dere) a)
?~ res (need (dere a))
[%batch u.res]
|= a=json
^- (unit response)
=/ res=(unit [@t json])
::TODO breaks when no id present
((ot id+so result+some ~) a)
?^ res `[%result u.res]
~| a
:+ ~ %error %- need
((ot id+so error+(ot code+no message+so ~) ~) a)
--
--

28
desk/mar/kelvin.hoon
View File

@ -1,28 +0,0 @@
|_ kal=waft:clay
++ grow
|%
++ mime `^mime`[/text/x-kelvin (as-octs:mimes:html hoon)]
++ noun kal
++ hoon
%+ rap 3
%+ turn
%+ sort
~(tap in (waft-to-wefts:clay kal))
|= [a=weft b=weft]
?: =(lal.a lal.b)
(gte num.a num.b)
(gte lal.a lal.b)
|= =weft
(rap 3 '[%' (scot %tas lal.weft) ' ' (scot %ud num.weft) ']\0a' ~)
::
++ txt (to-wain:format hoon)
--
++ grab
|%
++ noun waft:clay
++ mime
|= [=mite len=@ud tex=@]
(cord-to-waft:clay tex)
--
++ grad %noun
--

18
desk/mar/language-server/rpc/notification.hoon
View File

@ -1,18 +0,0 @@
/- *language-server
/+ lsp-json=language-server-json
|_ not=all:notification
++ grad %noun
++ grab
|%
++ noun all:notification
++ json
|= jon=^json
(notification:dejs:lsp-json jon)
--
++ grow
|%
++ noun not
++ json
(notification:enjs:lsp-json not)
--
--

16
desk/mar/language-server/rpc/request.hoon
View File

@ -1,16 +0,0 @@
/- *language-server
/+ lsp-json=language-server-json
|_ req=all:request
++ grad %noun
++ grow
|%
++ noun req
--
++ grab
|%
++ noun all:request
++ json
|= jon=^json
(request:dejs:lsp-json jon)
--
--

17
desk/mar/language-server/rpc/response.hoon
View File

@ -1,17 +0,0 @@
/- *language-server
/+ lsp=language-server-json
|_ res=all:response
::
++ grad %noun
++ grow
|%
++ noun res
++ json (response:enjs:lsp res)
--
::
++ grab
|%
++ noun all:response
--
::
--

32
desk/mar/mime.hoon
View File

@ -1,32 +0,0 @@
::
:::: /hoon/mime/mar
::
/? 310
::
|_ own=mime
++ grow
^?
|%
++ jam `@`q.q.own
--
::
++ grab :: convert from
^?
|%
++ noun mime :: clam from %noun
++ tape
|=(a=_"" [/application/x-urb-unknown (as-octt:mimes:html a)])
--
++ grad
^?
|%
++ form %mime
++ diff |=(mime +<)
++ pact |=(mime +<)
++ join |=([mime mime] `(unit mime)`~)
++ mash
|= [[ship desk mime] [ship desk mime]]
^- mime
~|(%mime-mash !!)
--
--

19
desk/mar/noun.hoon
View File

@ -1,19 +0,0 @@
::
:::: /hoon/noun/mar
::
/? 310
!:
:::: A minimal noun mark
|_ non=*
++ grab |%
++ noun *
--
++ grad
|%
++ form %noun
++ diff |=(* +<)
++ pact |=(* +<)
++ join |=([* *] *(unit *))
++ mash |=([[ship desk *] [ship desk *]] `*`~|(%noun-mash !!))
--
--

11
desk/mar/path.hoon
View File

@ -1,11 +0,0 @@
|_ pax=path
++ grad %noun
++ grow
|%
++ noun pax
--
++ grab
|%
++ noun path
--
--

12
desk/mar/png.hoon
View File

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

18
desk/mar/purl.hoon
View File

@ -1,18 +0,0 @@
::
:::: /hoon/purl/mar
::
/? 310
=, eyre
|_ url=purl
++ grad %noun
::
++ grow
|%
++ noun url
++ hiss [url %get ~ ~]
--
++ grab :: convert from
|%
++ noun purl :: clam from %noun
--
--

50
desk/mar/sole/action.hoon
View File

@ -1,50 +0,0 @@
::
:::: /hoon/action/sole/mar
::
/? 310
/- sole
::
::::
::
=, sole
|_ sole-action
::
++ grad %noun
++ grow
|%
++ noun +<.grad
--
++ grab :: convert from
|%
++ json
|= jon=^json ^- sole-action
%- need %. jon
=> [dejs-soft:format ..sole-action]
|^ (ot id+so dat+(fo %ret (of det+change tab+ni ~)) ~)
++ fo
|* [a=term b=fist]
|=(c=json ?.(=([%s a] c) (b c) (some [a ~])))
::
++ ra
|* [a=[term fist] b=fist]
|= c=json %. c
?.(=(%a -.c) b (pe -.a (ar +.a)))
::
++ ke :: callbacks
|* [gar=* sef=(trap fist)]
|= jon=json ^- (unit _gar)
=- ~! gar ~! (need -) -
((sef) jon)
::
++ change (ot ler+(at ni ni ~) ted+(pe 0v0 edit) ~)
++ char (cu taft so)
++ edit
%+ ke *sole-edit |. ~+
%+ fo %nop
%+ ra mor+edit
(of del+ni set+(cu tuba sa) ins+(ot at+ni cha+char ~) ~)
--
::
++ noun sole-action :: clam from %noun
--
--

82
desk/mar/sole/effect.hoon
View File

@ -1,82 +0,0 @@
::
:::: /hoon/effect/sole/mar
::
/? 310
/- sole
!:
::
::::
::
=, sole
=, format
|%
++ mar-sole-change :: XX dependency
|_ cha=sole-change
++ grow
|% ++ json
^- ^json
=, enjs
=; edi
=,(cha (pairs ted+(edi ted) ler+a+~[(numb own.ler) (numb his.ler)] ~))
|= det=sole-edit
?- -.det
%nop [%s 'nop']
%mor [%a (turn p.det ..$)]
%del (frond %del (numb p.det))
%set (frond %set (tape (tufa p.det)))
%ins (frond %ins (pairs at+(numb p.det) cha+s+(tuft q.det) ~))
==
--
--
++ wush
|= [wid=@u tan=tang]
^- tape
(of-wall (turn (flop tan) |=(a=tank (of-wall (wash 0^wid a)))))
::
++ purge :: discard ++styx style
|= a=styx ^- tape
%- zing %+ turn a
|= a=_?>(?=(^ a) i.a)
?@(a (trip a) ^$(a q.a))
--
::
|_ sef=sole-effect
::
++ grad %noun
++ grab :: convert from
|%
++ noun sole-effect :: clam from %noun
--
++ grow
=, enjs
|%
++ noun sef
++ json
^- ^json
?+ -.sef
~|(unsupported-effect+-.sef !!)
%mor [%a (turn p.sef |=(a=sole-effect json(sef a)))]
%err (frond %hop (numb p.sef))
%txt (frond %txt (tape p.sef))
%tan (frond %tan (tape (wush 160 p.sef)))
%det (frond %det json:~(grow mar-sole-change +.sef))
::
%pro
%+ frond %pro
(pairs vis+b+vis.sef tag+s+tag.sef cad+(tape (purge cad.sef)) ~)
::
%tab
:- %a
%+ turn p.sef
|= [=cord =^tank]
%+ frond %tab
%- pairs
:~ match+s+cord
info+(tape ~(ram re tank))
==
::
?(%bel %clr %nex %bye)
(frond %act %s -.sef)
==
--
--

30
desk/mar/tang.hoon
View File

@ -1,30 +0,0 @@
::
:::: /hoon/tang/mar
::
/? 310
::
=, format
|_ tan=(list tank)
++ grad %noun
++ grow
|%
++ noun tan
++ json
=/ result=(each (list ^json) tang)
(mule |.((turn tan tank:enjs:format)))
?- -.result
%& a+p.result
%| a+[a+[%s '[[output rendering error]]']~]~
==
::
++ elem
=- ;pre:code:"{(of-wall -)}"
^- wall %- zing ^- (list wall)
(turn (flop tan) |=(a=tank (wash 0^160 a)))
--
++ grab :: convert from
|%
++ noun (list ^tank) :: clam from %noun
++ tank |=(a=^tank [a]~)
--
--

12
desk/mar/tape.hoon
View File

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

16
desk/mar/txt-diff.hoon
View File

@ -1,16 +0,0 @@
::
:::: /hoon/txt-diff/mar
::
/? 310
|_ txt-diff=(urge:clay cord)
::
++ grad %noun
++ grow
|%
++ noun txt-diff
--
++ grab :: convert from
|%
++ noun (urge:clay cord) :: make from %noun
--
--

275
desk/mar/txt.hoon
View File

@ -1,275 +0,0 @@
::
:::: /hoon/txt/mar
::
/? 310
::
=, clay
=, differ
=, format
=, mimes:html
|_ txt=wain
::
++ grab :: convert from
|%
++ mime |=((pair mite octs) (to-wain q.q))
++ noun wain :: clam from %noun
--
++ grow
=> v=.
|%
++ mime => v [/text/plain (as-octs (of-wain txt))]
++ elem => v ;pre: {(trip (of-wain txt))}
--
++ grad
|%
++ form %txt-diff
++ diff
|= tyt=wain
^- (urge cord)
(lusk txt tyt (loss txt tyt))
::
++ pact
|= dif=(urge cord)
~| [%pacting dif]
^- wain
(lurk txt dif)
::
++ join
|= [ali=(urge cord) bob=(urge cord)]
^- (unit (urge cord))
|^
=. ali (clean ali)
=. bob (clean bob)
|- ^- (unit (urge cord))
?~ ali `bob
?~ bob `ali
?- -.i.ali
%&
?- -.i.bob
%&
?: =(p.i.ali p.i.bob)
%+ bind $(ali t.ali, bob t.bob)
|=(cud=(urge cord) [i.ali cud])
?: (gth p.i.ali p.i.bob)
%+ bind $(p.i.ali (sub p.i.ali p.i.bob), bob t.bob)
|=(cud=(urge cord) [i.bob cud])
%+ bind $(ali t.ali, p.i.bob (sub p.i.bob p.i.ali))
|=(cud=(urge cord) [i.ali cud])
::
%|
?: =(p.i.ali (lent p.i.bob))
%+ bind $(ali t.ali, bob t.bob)
|=(cud=(urge cord) [i.bob cud])
?: (gth p.i.ali (lent p.i.bob))
%+ bind $(p.i.ali (sub p.i.ali (lent p.i.bob)), bob t.bob)
|=(cud=(urge cord) [i.bob cud])
~
==
::
%|
?- -.i.bob
%|
?. =(i.ali i.bob)
~
%+ bind $(ali t.ali, bob t.bob)
|=(cud=(urge cord) [i.ali cud])
::
%&
?: =(p.i.bob (lent p.i.ali))
%+ bind $(ali t.ali, bob t.bob)
|=(cud=(urge cord) [i.ali cud])
?: (gth p.i.bob (lent p.i.ali))
%+ bind $(ali t.ali, p.i.bob (sub p.i.bob (lent p.i.ali)))
|=(cud=(urge cord) [i.ali cud])
~
==
==
++ clean :: clean
|= wig=(urge cord)
^- (urge cord)
?~ wig ~
?~ t.wig wig
?: ?=(%& -.i.wig)
?: ?=(%& -.i.t.wig)
$(wig [[%& (add p.i.wig p.i.t.wig)] t.t.wig])
[i.wig $(wig t.wig)]
?: ?=(%| -.i.t.wig)
$(wig [[%| (welp p.i.wig p.i.t.wig) (welp q.i.wig q.i.t.wig)] t.t.wig])
[i.wig $(wig t.wig)]
--
::
++ mash
|= $: [als=ship ald=desk ali=(urge cord)]
[bos=ship bod=desk bob=(urge cord)]
==
^- (urge cord)
|^
=. ali (clean ali)
=. bob (clean bob)
|- ^- (urge cord)
?~ ali bob
?~ bob ali
?- -.i.ali
%&
?- -.i.bob
%&
?: =(p.i.ali p.i.bob)
[i.ali $(ali t.ali, bob t.bob)]
?: (gth p.i.ali p.i.bob)
[i.bob $(p.i.ali (sub p.i.ali p.i.bob), bob t.bob)]
[i.ali $(ali t.ali, p.i.bob (sub p.i.bob p.i.ali))]
::
%|
?: =(p.i.ali (lent p.i.bob))
[i.bob $(ali t.ali, bob t.bob)]
?: (gth p.i.ali (lent p.i.bob))
[i.bob $(p.i.ali (sub p.i.ali (lent p.i.bob)), bob t.bob)]
=/ [fic=(unce cord) ali=(urge cord) bob=(urge cord)]
(resolve ali bob)
[fic $(ali ali, bob bob)]
:: ~ :: here, alice is good for a while, but not for the whole
== :: length of bob's changes
::
%|
?- -.i.bob
%|
=/ [fic=(unce cord) ali=(urge cord) bob=(urge cord)]
(resolve ali bob)
[fic $(ali ali, bob bob)]
::
%&
?: =(p.i.bob (lent p.i.ali))
[i.ali $(ali t.ali, bob t.bob)]
?: (gth p.i.bob (lent p.i.ali))
[i.ali $(ali t.ali, p.i.bob (sub p.i.bob (lent p.i.ali)))]
=/ [fic=(unce cord) ali=(urge cord) bob=(urge cord)]
(resolve ali bob)
[fic $(ali ali, bob bob)]
==
==
::
++ annotate :: annotate conflict
|= $: ali=(list @t)
bob=(list @t)
bas=(list @t)
==
^- (list @t)
%- zing
^- (list (list @t))
%- flop
^- (list (list @t))
:- :_ ~
%^ cat 3 '<<<<<<<<<<<<'
%^ cat 3 ' '
%^ cat 3 `@t`(scot %p bos)
%^ cat 3 '/'
bod
:- bob
:- ~['------------']
:- bas
:- ~['++++++++++++']
:- ali
:- :_ ~
%^ cat 3 '>>>>>>>>>>>>'
%^ cat 3 ' '
%^ cat 3 `@t`(scot %p als)
%^ cat 3 '/'
ald
~
::
++ clean :: clean
|= wig=(urge cord)
^- (urge cord)
?~ wig ~
?~ t.wig wig
?: ?=(%& -.i.wig)
?: ?=(%& -.i.t.wig)
$(wig [[%& (add p.i.wig p.i.t.wig)] t.t.wig])
[i.wig $(wig t.wig)]
?: ?=(%| -.i.t.wig)
$(wig [[%| (welp p.i.wig p.i.t.wig) (welp q.i.wig q.i.t.wig)] t.t.wig])
[i.wig $(wig t.wig)]
::
++ resolve
|= [ali=(urge cord) bob=(urge cord)]
^- [fic=[%| p=(list cord) q=(list cord)] ali=(urge cord) bob=(urge cord)]
=- [[%| bac (annotate alc boc bac)] ali bob]
|- ^- $: $: bac=(list cord)
alc=(list cord)
boc=(list cord)
==
ali=(urge cord)
bob=(urge cord)
==
?~ ali [[~ ~ ~] ali bob]
?~ bob [[~ ~ ~] ali bob]
?- -.i.ali
%&
?- -.i.bob
%& [[~ ~ ~] ali bob] :: no conflict
%|
=+ lob=(lent p.i.bob)
?: =(lob p.i.ali)
[[p.i.bob p.i.bob q.i.bob] t.ali t.bob]
?: (lth lob p.i.ali)
[[p.i.bob p.i.bob q.i.bob] [[%& (sub p.i.ali lob)] t.ali] t.bob]
=+ wat=(scag (sub lob p.i.ali) p.i.bob)
=+ ^= res
%= $
ali t.ali
bob [[%| (scag (sub lob p.i.ali) p.i.bob) ~] t.bob]
==
:* :* (welp bac.res wat)
(welp alc.res wat)
(welp boc.res q.i.bob)
==
ali.res
bob.res
==
==
::
%|
?- -.i.bob
%&
=+ loa=(lent p.i.ali)
?: =(loa p.i.bob)
[[p.i.ali q.i.ali p.i.ali] t.ali t.bob]
?: (lth loa p.i.bob)
[[p.i.ali q.i.ali p.i.ali] t.ali [[%& (sub p.i.bob loa)] t.bob]]
=+ wat=(slag (sub loa p.i.bob) p.i.ali)
=+ ^= res
%= $
ali [[%| (scag (sub loa p.i.bob) p.i.ali) ~] t.ali]
bob t.bob
==
:* :* (welp bac.res wat)
(welp alc.res q.i.ali)
(welp boc.res wat)
==
ali.res
bob.res
==
::
%|
=+ loa=(lent p.i.ali)
=+ lob=(lent p.i.bob)
?: =(loa lob)
[[p.i.ali q.i.ali q.i.bob] t.ali t.bob]
=+ ^= res
?: (gth loa lob)
$(ali [[%| (scag (sub loa lob) p.i.ali) ~] t.ali], bob t.bob)
~& [%scagging loa=loa pibob=p.i.bob slag=(scag loa p.i.bob)]
$(ali t.ali, bob [[%| (scag (sub lob loa) p.i.bob) ~] t.bob])
:* :* (welp bac.res ?:((gth loa lob) p.i.bob p.i.ali))
(welp alc.res q.i.ali)
(welp boc.res q.i.bob)
==
ali.res
bob.res
==
==
==
--
--
--

31
desk/mar/udon.hoon
View File

@ -1,31 +0,0 @@
::
:::: /hoon/udon/mar
::
/+ cram
::
|_ mud=@t
++ grow
|%
++ mime [/text/x-unmark (as-octs:mimes:html mud)]
++ txt
(to-wain:format mud)
++ elem
^- manx
=, cram
elm:(static (ream mud))
++ front :: XX performance, types
^- (map term knot)
%- ~(run by inf:(static:cram (ream mud)))
|= a=dime ^- cord
?+ (end 3 p.a) (scot a)
%t q.a
==
--
++ grab
|%
++ mime |=((pair mite octs) q.q)
++ noun @t
++ txt of-wain:format
--
++ grad %txt
--

32
desk/mar/umd.hoon
View File

@ -1,32 +0,0 @@
::
:::: /hoon/umd/mar
::
/+ cram
::
|_ mud=@t
++ grow
|%
++ mime [/text/x-unmark (as-octs:mimes:html mud)]
++ txt
(to-wain:format mud)
++ elem
^- manx
=, cram
elm:(static (ream mud))
++ front :: XX performance, types
^- (map term knot)
%- ~(run by inf:(static:cram (ream mud)))
|= a=dime ^- cord
?+ (end 3 p.a) (scot a)
%t q.a
==
--
++ grab
|%
++ mime |=((pair mite octs) q.q)
++ noun @t
++ txt of-wain:format
--
++ grad %txt
++ garb /down
--

18
desk/mar/urb.hoon
View File

@ -1,18 +0,0 @@
::
:::: /hoon/elem/urb/mar
::
/? 310
=, mimes:html
=, html
|_ own=manx
::
++ grad %noun
++ grow :: convert to
|%
++ hymn ;html:(head body:"+{own}") :: convert to %hymn
++ html (crip (en-xml hymn)) :: convert to %html
++ mime [/text/html (as-octs html)] :: convert to %mime
--
++ grab |% :: convert from
++ noun manx :: clam from %noun
-- --

17
desk/mar/urbit.hoon
View File

@ -1,17 +0,0 @@
::
:::: /hoon/urbit/mar
::
/? 310
:::: A minimal urbit mark
::
|_ her=@p
++ grab
|%
++ noun @p
--
++ grow
|%
++ noun her
--
++ grad %noun
--

12
desk/mar/woff2.hoon
View File

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

21
desk/mar/xml.hoon
View File

@ -1,21 +0,0 @@
::
:::: /hoon/xml/mar
::
/? 310
::
:::: compute
::
=, mimes:html
=, html
|_ xml=@t
::
++ grad %mime
++ grow :: convert to
|% ::
++ mime [/application/xml (as-octs xml)] :: to %mime
++ hymn (need (de-xml xml)) :: to %hymn
-- ::
++ grab |% :: convert from
++ noun @t :: clam from %noun
++ mime |=([p=mite q=octs] q.q) :: retrieve form %mime
-- --

85
desk/sur/aquarium.hoon
View File

@ -1,85 +0,0 @@
:: Traditionally, ovo refers to an ovum -- (pair wire card) -- and ova
:: refers to a list of them. We have several versions of each of these
:: depending on context, so we do away with that naming scheme and use
:: the following naming scheme.
::
:: Every card is either an `event` or an `effect`. Prepended to this
:: is `unix` if it has no ship associated with it, or `aqua` if it
:: does. `timed` is added if it includes the time of the event.
::
:: Short names are simply the first letter of each word plus `s` if
:: it's a list.
::
/+ pill
=, pill-lib=pill
|%
+$ az-log [topics=(lest @) data=@t]
+$ az-state
$: logs=(list az-log)
lives=(map ship [lyfe=life rut=rift])
tym=@da
==
++ ph-event
$% [%test-done p=?]
aqua-event
==
::
+$ unix-event ::NOTE like unix-event:pill-lib but for all tasks
%+ pair wire
$% [%wack p=@]
[%what p=(list (pair path (cask)))]
[%whom p=ship]
[%boot ? $%($>(%fake task:jael) $>(%dawn task:jael))]
[%wyrd p=vere]
[%verb p=(unit ?)]
task-arvo
==
+$ pill pill:pill-lib
::
+$ aqua-event
$% [%init-ship who=ship fake=?]
[%pause-events who=ship]
[%snap-ships lab=term hers=(list ship)]
[%restore-snap lab=term]
[%event who=ship ue=unix-event]
==
::
+$ azimuth-action
$% [%init-azimuth ~]
[%spawn who=ship]
[%breach who=ship]
==
::
+$ aqua-effects
[who=ship ufs=(list unix-effect)]
::
+$ aqua-effect
[who=ship ufs=unix-effect]
::
+$ aqua-events
[who=ship utes=(list unix-timed-event)]
::
+$ aqua-boths
[who=ship ub=(list unix-both)]
::
+$ unix-both
$% [%event unix-timed-event]
[%effect unix-effect]
==
::
+$ unix-timed-event [tym=@da ue=unix-event]
::
+$ unix-effect
%+ pair wire
$% [%blit p=(list blit:dill)]
[%send p=lane:ames q=@]
[%doze p=(unit @da)]
[%thus p=@ud q=(unit hiss:eyre)]
[%ergo p=@tas q=mode:clay]
[%sleep ~]
[%restore ~]
[%kill ~]
[%init ~]
[%request id=@ud request=request:http]
==
--

80
desk/sur/asn1.hoon
View File

@ -1,80 +0,0 @@
:: |asn1: small selection of types and constants for ASN.1
::
:: A minimal representation of some basic ASN.1 types,
:: created to support PKCS keys, digests, and cert requests.
::
^?
|%
:: +bespoke:asn1: context-specific, generic ASN.1 tag type
::
:: Note that *explicit* implies *constructed* (ie, bit 5 is set in DER).
::
+$ bespoke
:: imp: & is implicit, | is explicit
:: tag: 5 bits for the custom tag number
::
[imp=? tag=@ud]
:: +spec:asn1: minimal representations of basic ASN.1 types
::
+$ spec
$% :: %int: arbitrary-sized, unsigned integers
::
:: Unsigned integers, represented as having a positive sign.
:: Negative integers would be two's complement in DER,
:: but we don't need them.
::
[%int int=@u]
:: %bit: very minimal support for bit strings
::
:: Specifically, values must already be padded and byte-aligned.
:: len: bitwidth
:: bit: data
::
[%bit len=@ud bit=@ux]
:: %oct: octets in little-endian byte order
::
:: len: bytewidth
:: bit: data
::
[%oct len=@ud oct=@ux]
:: %nul: fully supported!
::
[%nul ~]
:: %obj: object identifiers, pre-packed
::
:: Object identifiers are technically a sequence of integers,
:: represented here in their already-encoded form.
::
[%obj obj=@ux]
:: %seq: a list of specs
::
[%seq seq=(list spec)]
:: %set: a logical set of specs
::
:: Implemented here as a list for the sake of simplicity.
:: must be already deduplicated and sorted!
::
[%set set=(list spec)]
:: %con: context-specific
::
:: General support for context-specific tags.
:: bes: custom tag number, implicit or explicit
:: con: already-encoded bytes
::
[%con bes=bespoke con=(list @D)]
==
:: |obj:asn1: constant object ids, pre-encoded
::
++ obj
^?
|% :: rfc4055
++ sha-256 0x1.0204.0365.0148.8660 :: 2.16.840.1.101.3.4.2.1
++ rsa 0x1.0101.0df7.8648.862a :: 1.2.840.113549.1.1.1
++ rsa-sha-256 0xb.0101.0df7.8648.862a :: 1.2.840.113549.1.1.11
:: rfc2985
++ csr-ext 0xe.0901.0df7.8648.862a :: 1.2.840.113549.1.9.14
:: rfc3280
++ sub-alt 0x11.1d55 :: 2.5.29.17
--
--

84
desk/sur/bitcoin.hoon
View File

@ -1,84 +0,0 @@
:: 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 %regtest)
+$ 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
--
--

198
desk/sur/hood.hoon
View File

@ -1,3 +1,4 @@
:: only the types from base-dev/sur/hood.hoon
=, clay
=* dude dude:gall
|%
@ -16,199 +17,4 @@
::
+$ sync-state [nun=@ta kid=(unit desk) let=@ud]
+$ sink (unit [her=@p sud=desk kid=(unit desk) let=@ud])
:: +report-prep: get data required for reports
::
++ report-prep
|= [our=@p now=@da]
=/ ego (scot %p our)
=/ wen (scot %da now)
:* .^(rock:tire %cx /(scot %p our)//(scot %da now)/tire)
.^(=cone %cx /(scot %p our)//(scot %da now)/domes)
.^((map desk [ship desk]) %gx /[ego]/hood/[wen]/kiln/sources/noun)
.^ (map [desk ship desk] sync-state) %gx
/[ego]/hood/[wen]/kiln/syncs/noun
==
==
:: +report-vats: report on all desk installations
::
++ report-vats
|= [our=@p now=@da]
^- tang
=/ desks .^((set desk) %cd /(scot %p our)/base/(scot %da now))
=/ prep (report-prep our now)
%+ turn ~(tap in desks)
|=(syd=desk (report-vat prep our now syd))
:: +report-vat: report on a single desk installation
::
++ report-vat
|= $: $: tyr=rock:tire =cone sor=(map desk [ship desk])
zyn=(map [desk ship desk] sync-state)
==
our=ship now=@da syd=desk
==
^- tank
=/ ego (scot %p our)
=/ wen (scot %da now)
=+ .^(=cass %cw /[ego]/[syd]/[wen])
?: =(ud.cass 0)
leaf+"desk does not yet exist: {<syd>}"
?: =(%kids syd)
=+ .^(hash=@uv %cz /[ego]/[syd]/[wen])
leaf+"%kids %cz hash: {<hash>}"
=/ kel-path
/[ego]/[syd]/[wen]/sys/kelvin
?. .^(? %cu kel-path)
leaf+"bad desk: {<syd>}"
=+ .^(=waft %cx kel-path)
:+ %rose ["" "{<syd>}" "::"]
^- tang
=/ hash .^(@uv %cz /[ego]/[syd]/[wen])
=/ =sink
?~ s=(~(get by sor) syd)
~
?~ z=(~(get by zyn) syd u.s)
~
`[-.u.s +.u.s +.u.z]
=/ meb=(list @uv)
?~ sink [hash]~
(mergebase-hashes our syd now her.u.sink sud.u.sink)
=/ dek (~(got by tyr) syd)
=/ =foam (~(got by cone) our syd)
=/ [on=(list [@tas ?]) of=(list [@tas ?])]
(skid ~(tap by ren.foam) |=([* ?] +<+))
=/ sat
?- zest.dek
%live "running"
%dead "suspended"
%held "suspended until next update"
==
=/ kul=tape
%+ roll
%+ sort
~(tap in (waft-to-wefts:clay waft))
|= [a=weft b=weft]
?: =(lal.a lal.b)
(lte num.a num.b)
(lte lal.a lal.b)
|= [=weft =tape]
(welp " {<[lal num]:weft>}" tape)
:~ leaf/"/sys/kelvin: {kul}"
leaf/"base hash: {?.(=(1 (lent meb)) <meb> <(head meb)>)}"
leaf/"%cz hash: {<hash>}"
::
leaf/"app status: {sat}"
leaf/"force on: {?:(=(~ on) "~" <on>)}"
leaf/"force off: {?:(=(~ of) "~" <of>)}"
::
leaf/"publishing ship: {?~(sink <~> <(get-publisher our syd now)>)}"
leaf/"updates: {?~(sink "local" "remote")}"
leaf/"source ship: {?~(sink <~> <her.u.sink>)}"
leaf/"source desk: {?~(sink <~> <sud.u.sink>)}"
leaf/"source aeon: {?~(sink <~> <let.u.sink>)}"
leaf/"kids desk: {?~(sink <~> ?~(kid.u.sink <~> <u.kid.u.sink>))}"
leaf/"pending updates: {<`(list [@tas @ud])`~(tap in wic.dek)>}"
==
:: +report-kids: non-vat cz hash report for kids desk
::
++ report-kids
|= [our=ship now=@da]
^- tank
=/ syd %kids
=/ ego (scot %p our)
=/ wen (scot %da now)
?. (~(has in .^((set desk) %cd /[ego]//[wen])) syd)
leaf/"no %kids desk"
=+ .^(hash=@uv %cz /[ego]/[syd]/[wen])
leaf/"%kids %cz hash: {<hash>}"
:: +read-bill-foreign: read /desk/bill from a foreign desk
::
++ read-bill-foreign
|= [=ship =desk =aeon]
^- (list dude)
~| +<
=/ her (scot %p ship)
=/ syd (scot %tas desk)
=/ yon (scot %ud aeon)
::
=/ dom .^(dome cv/~[her syd yon])
=/ tak ~| aeons=~(key by hit.dom)
(scot %uv (~(got by hit.dom) aeon))
=/ yak .^(yaki cs/~[her syd yon %yaki tak])
=/ fil (~(get by q.yak) /desk/bill)
?~ fil ~
=/ lob (scot %uv u.fil)
=/ peg .^(page cs/~[her syd yon %blob lob])
;;((list dude) q.peg)
:: +read-bill: read contents of /desk/bill manifest
::
++ read-bill
|= [our=ship =desk now=@da]
=/ pax (en-beam [our desk da+now] /desk/bill)
?. .^(? cu/pax)
*(list dude)
.^((list dude) cx/pax)
::
++ get-remote-diff
|= [our=ship here=desk now=@da her=ship there=desk when=aeon]
=+ .^(our-hash=@uv cz/[(scot %p our) here (scot %da now) ~])
=+ .^(her-hash=@uv cz/[(scot %p her) there (scot %ud when) ~])
!=(our-hash her-hash)
::
++ get-publisher
|= [our=ship =desk now=@da]
^- (unit ship)
=/ pax /(scot %p our)/[desk]/(scot %da now)/desk/ship
?. .^(? %cu pax) ~
`.^(ship %cx pax)
::
++ get-apps-live
|= [our=ship =desk now=@da]
^- (list dude)
%+ murn (get-apps-have our desk now)
|=([=dude live=?] ?.(live ~ `dude))
:: +get-apps-have: find which apps Gall is running on a desk
::
++ get-apps-have
|= [our=ship =desk now=@da]
^- (list [=dude live=?])
%~ tap in
.^((set [=dude live=?]) ge+/(scot %p our)/[desk]/(scot %da now))
::
++ mergebase-hashes
|= [our=@p syd=desk now=@da her=ship sud=desk]
=/ her (scot %p her)
=/ ego (scot %p our)
=/ wen (scot %da now)
%+ turn .^((list tako) %cs ~[ego syd wen %base her sud])
|=(=tako .^(@uv %cs ~[ego syd wen %hash (scot %uv tako)]))
::
++ enjs
=, enjs:format
|%
++ tim
|= t=@
^- json
(numb (fall (mole |.((unm:chrono:userlib t))) 0))
::
++ cass
|= c=^cass
%- pairs
:~ ud+(numb ud.c)
da+(tim da.c)
==
::
++ weft
|= w=^weft
%- pairs
:~ name+s+lal.w
kelvin+(numb num.w)
==
::
++ rung
|= r=^rung
%- pairs
:~ aeon+(numb aeon.r)
weft+(weft weft.r)
==
--
--
--

28
desk/sur/json/rpc.hoon
View File

@ -1,28 +0,0 @@
:: json-rpc: protocol types
::
|%
+$ batch-request
$% [%a p=(list request)]
[%o p=request]
==
::
+$ request
$: id=@t
jsonrpc=@t
method=@t
params=request-params
==
::
+$ request-params
$% [%list (list json)]
[%map (map @t json)]
[%object (list (pair @t json))]
==
+$ response
$~ [%fail *httr:eyre]
$% [%result id=@t res=json]
[%error id=@t code=@t message=@t] ::TODO data?
[%fail hit=httr:eyre]
[%batch bas=(list response)]
==
--

23
desk/sur/keygen.hoon
View File

@ -1,23 +0,0 @@
|%
+$ revision @ud
+$ nodetype tape
+$ mnemonic tape
::
+$ vault
$: ownership=node
voting=node
management=node
transfer=node
spawn=node
network=uode
==
::
+$ node [type=nodetype seed=mnemonic keys=wallet]
+$ uode [revi=revision seed=@ux keys=edkeys]
::
+$ wallet [keys=[public=@ux private=@ux] addr=@ux chain=@ux]
::
+$ edkeys [auth=keypair crypt=keypair]
::
+$ keypair [public=@ux secret=@ux]
--

114
desk/sur/language-server.hoon
View File

@ -1,114 +0,0 @@
|%
::
+$ versioned-doc-id
[uri=@t version=(unit @)]
::
++ request
|%
+$ all
$%
text-document--hover
text-document--completion
unknown
==
+$ text-document--hover
[%text-document--hover id=cord position versioned-doc-id]
+$ text-document--completion
[%text-document--completion id=cord position versioned-doc-id]
+$ unknown
[%unknown json]
--
++ response
|%
+$ all
$%
text-document--hover
text-document--completion
==
+$ text-document--hover
[%text-document--hover id=cord contents=(unit @t)]
+$ text-document--completion
[%text-document--completion id=cord completion=(list completion-item)]
--
::
+$ completion-item
$:
label=cord
kind=@ud
detail=cord
doc=cord
insert-text=cord
insert-text-format=@ud
==
::
+$ diagnostic
[=range severity=@ud message=@t]
::
+$ position
[row=@ud col=@ud]
::
+$ text-document-item
[uri=@t version=(unit @) text=@t]
::
++ notification
|%
::
+$ in
$%
text-document--did-change
text-document--did-open
text-document--did-save
text-document--did-close
exit
unknown
==
::
+$ out
$%
text-document--publish-diagnostics
==
::
+$ all
$%
out
in
==
::
+$ text-document--did-change
[%text-document--did-change versioned-doc-id changes=(list change)]
::
+$ text-document--did-open
[%text-document--did-open text-document-item]
::
+$ text-document--did-save
[%text-document--did-save versioned-doc-id]
::
+$ text-document--did-close
[%text-document--did-close versioned-doc-id]
::
+$ exit
[%exit ~]
::
+$ unknown
[%unknown =json]
::
+$ text-document--publish-diagnostics
[%text-document--publish-diagnostics uri=@t diagnostics=(list diagnostic)]
::
--
::
+$ change
$: range=(unit range)
range-length=(unit @ud)
text=@t
==
::
+$ range
$: start=position
end=position
==
::
--

47
desk/sur/ring.hoon
View File

@ -1,47 +0,0 @@
|%
:: +raw-ring-signature: low level ring signature type
::
:: The :s field of a ring signature grows O(n) with the number of
:: participants in the ring.
::
++ raw-ring-signature
$: ch0=@
::
s=(list @)
:: linked ring signature tag
::
:: Two linked ring signatures with the same link scope can be shown to
:: have been made by the same private key, leading to Sybil
:: resistance...but if your private keys are compromised, your
:: adversary can determine which signatures you made.
::
y=(unit @udpoint)
==
:: +ring-signature: higher level ring signature type
::
:: This contains all the identifying information to verify a ring signature
:: in an urbit context.
::
++ ring-signature
$: :: a ring signature is computed over a set of public keys. the
:: participants set is not those keys, but static references to them.
::
participants=(set [ship=@p =life])
:: the linkage scope this signature was made on
::
link-scope=(unit *)
:: the rest of the low level ring signature is appended
::
raw=raw-ring-signature
==
::
+$ ring-group
$: :: a ring signature is computed over a set of public keys. the
:: participants set is not those keys, but static references to them.
::
participants=(set [ship=@p =life])
:: the linkage scope this signature was made on
::
link-scope=(unit *)
==
--

87
desk/sur/sole.hoon
View File

@ -1,87 +0,0 @@
::
:::: /hoon/sole/sur
::
^?
|%
+$ sole-action :: sole to app
$: id=@ta :: duct id
$= dat
$% :: [%abo ~] :: reset interaction
[%det sole-change] :: command line edit
[%ret ~] :: submit and clear
[%clr ~] :: exit context
[%tab pos=@ud] :: tab complete
== ::
==
+$ sole-buffer (list @c) :: command state
+$ sole-change :: network change
$: ler=sole-clock :: destination clock
haw=@uvH :: source hash
ted=sole-edit :: state change
== ::
+$ sole-clock [own=@ud his=@ud] :: vector clock
+$ sole-edit :: shared state change
$% [%del p=@ud] :: delete one at
[%ins p=@ud q=@c] :: insert at
[%mor p=(list sole-edit)] :: combination
[%nop ~] :: no-op
[%set p=sole-buffer] :: discontinuity
== ::
+$ sole-effect :: app to sole
$% [%bel ~] :: beep
[%blk p=@ud q=@c] :: blink+match char at
[%bye ~] :: close session
[%clr ~] :: clear screen
[%det sole-change] :: edit command
[%err p=@ud] :: error point
[%klr p=styx] :: styled text line
[%mor p=(list sole-effect)] :: multiple effects
[%nex ~] :: save clear command
[%pro sole-prompt] :: set prompt
[%sag p=path q=*] :: save to jamfile
[%sav p=path q=@] :: save to file
[%tab p=(list [=cord =tank])] :: tab-complete list
[%tan p=(list tank)] :: classic tank
:: [%taq p=tanq] :: modern tank
[%txt p=tape] :: text line
[%url p=@t] :: activate url
== ::
+$ sole-command :: command state
$: pos=@ud :: cursor position
say=sole-share :: cursor
== ::
+$ sole-prompt :: prompt definition
$: vis=? :: command visible
tag=term :: history mode
cad=styx :: caption
== ::
+$ sole-share :: symmetric state
$: ven=sole-clock :: our vector clock
leg=(list sole-edit) :: unmerged edits
buf=sole-buffer :: sole state
== ::
:: ::
:: ::
++ sole-dialog :: standard dialog
|* out=$-(* *) :: output structure
$-(sole-input (sole-result out)) :: output function
:: ::
+$ sole-input tape :: prompt input
++ sole-result :: conditional result
|* out=$-(* *) :: output structure
$@(@ud (sole-product out)) :: error position
:: ::
++ sole-product :: success result
|* out=$-(* *) ::
%+ pair (list tank) ::
%+ each (unit out) :: ~ is abort
(pair sole-prompt (sole-dialog out)) :: ask and continue
:: ::
+$ sole-gen :: XX virtual type
$% [%say $-((sole-args) (cask))] :: direct noun
[%ask $-((sole-args) (sole-product (cask)))] :: dialog
== ::
++ sole-args :: generator arguments
|* _[* *] ::
,[[now=@da eny=@uvJ bek=beak] [,+<- ,+<+]] ::
--

27
desk/sur/spider.hoon
View File

@ -1,27 +0,0 @@
/+ libstrand=strand
=, strand=strand:libstrand
|%
+$ thread $-(vase shed:khan)
+$ input [=tid =cage]
+$ tid tid:strand
+$ bowl bowl:strand
+$ http-error
$? %bad-request :: 400
%forbidden :: 403
%nonexistent :: 404
%offline :: 504
==
+$ start-args
$: parent=(unit tid)
use=(unit tid)
=beak
file=term
=vase
==
+$ inline-args
$: parent=(unit tid)
use=(unit tid)
=beak
=shed:khan
==
--

12
desk/sur/verb.hoon
View File

@ -1,12 +0,0 @@
|%
+$ event
$% [%on-init ~]
[%on-load ~]
[%on-poke =mark]
[%on-watch =path]
[%on-leave =path]
[%on-agent =wire sign=term]
[%on-arvo =wire vane=term sign=term]
[%on-fail =term]
==
--

1
desk/sys.kelvin
View File

@ -1,3 +1,4 @@
[%zuse 417]
[%zuse 416]
[%zuse 415]
[%zuse 414]

2
ui/public/mockServiceWorker.js
View File

@ -2,7 +2,7 @@
/* tslint:disable */
/**
* Mock Service Worker (1.0.1).
* Mock Service Worker (1.2.1).
* @see https://github.com/mswjs/msw
* - Please do NOT modify this file.
* - Please do NOT serve this file on production.

36
ui/src/app.tsx
View File

@ -6,6 +6,8 @@ import {
Route,
useHistory,
useLocation,
RouteComponentProps,
Redirect,
} from 'react-router-dom';
import { ErrorBoundary } from 'react-error-boundary';
import FingerprintJS from '@fingerprintjs/fingerprintjs';
@ -21,6 +23,11 @@ import { useBrowserId, useLocalState } from './state/local';
import { ErrorAlert } from './components/ErrorAlert';
import { useErrorHandler } from './logic/useErrorHandler';
import useHarkState from './state/hark';
import { useNotifications } from './nav/notifications/useNotifications';
import {
isNewNotificationSupported,
makeBrowserNotification,
} from './logic/utils';
const getNoteRedirect = (path: string) => {
if (path.startsWith('/desk/')) {
@ -46,11 +53,35 @@ const getId = async () => {
return result.visitorId;
};
function OldLeapRedirect({ location }: RouteComponentProps) {
const path = location.pathname.replace('/leap', '');
return <Redirect to={path} />;
}
const AppRoutes = () => {
const { push } = useHistory();
const { search } = useLocation();
const handleError = useErrorHandler();
const browserId = useBrowserId();
const {
display: { doNotDisturb },
} = useSettingsState.getState();
const { count, unreadNotifications } = useNotifications();
useEffect(() => {
if (!isNewNotificationSupported() || doNotDisturb) {
return;
}
if (count > 0 && Notification.permission === 'granted') {
unreadNotifications.forEach((bin) => {
makeBrowserNotification(bin);
});
}
if (count > 0 && Notification.permission === 'default') {
Notification.requestPermission();
}
}, [count, unreadNotifications]);
useEffect(() => {
getId().then((value) => {
@ -101,7 +132,7 @@ const AppRoutes = () => {
useHarkState.getState().start();
Mousetrap.bind(['command+/', 'ctrl+/'], () => {
push('/leap/search');
push('/search');
});
}),
[]
@ -110,7 +141,8 @@ const AppRoutes = () => {
return (
<Switch>
<Route path="/perma" component={PermalinkRoutes} />
<Route path={['/leap/:menu', '/']} component={Grid} />
<Route path="/leap/*" component={OldLeapRedirect} />
<Route path={['/:menu', '/']} component={Grid} />
</Switch>
);
};

72
ui/src/components/AppInfo.tsx
View File

@ -3,7 +3,8 @@ import clipboardCopy from 'clipboard-copy';
import React, { FC, useCallback, useState } from 'react';
import cn from 'classnames';
import { Button, PillButton } from './Button';
import { Dialog, DialogClose, DialogContent, DialogTrigger } from './Dialog';
import * as Dialog from '@radix-ui/react-dialog';
import { DialogClose, DialogContent, DialogTrigger } from './Dialog';
import { DocketHeader } from './DocketHeader';
import { Spinner } from './Spinner';
import { PikeMeta } from './PikeMeta';
@ -18,6 +19,7 @@ type App = ChargeWithDesk | Treaty;
interface AppInfoProps {
docket: App;
pike?: Pike;
treatyInfoShip?: string;
className?: string;
}
@ -34,20 +36,25 @@ function getInstallStatus(docket: App): InstallStatus {
return 'uninstalled';
}
function getRemoteDesk(docket: App, pike?: Pike) {
function getRemoteDesk(docket: App, pike?: Pike, treatyInfoShip?: string) {
if (pike && pike.sync) {
return [pike.sync.ship, pike.sync.desk];
}
if ('chad' in docket) {
return ['', docket.desk];
return [treatyInfoShip ?? '', docket.desk];
}
const { ship, desk } = docket;
return [ship, desk];
}
export const AppInfo: FC<AppInfoProps> = ({ docket, pike, className }) => {
export const AppInfo: FC<AppInfoProps> = ({
docket,
pike,
className,
treatyInfoShip,
}) => {
const installStatus = getInstallStatus(docket);
const [ship, desk] = getRemoteDesk(docket, pike);
const [ship, desk] = getRemoteDesk(docket, pike, treatyInfoShip);
const publisher = pike?.sync?.ship ?? ship;
const [copied, setCopied] = useState(false);
const treaty = useTreaty(ship, desk);
@ -96,7 +103,7 @@ export const AppInfo: FC<AppInfoProps> = ({ docket, pike, className }) => {
</PillButton>
)}
{installStatus !== 'installed' && (
<Dialog>
<Dialog.Root>
<DialogTrigger asChild>
<PillButton variant="alt-primary" disabled={installing}>
{installing ? (
@ -109,31 +116,34 @@ export const AppInfo: FC<AppInfoProps> = ({ docket, pike, className }) => {
)}
</PillButton>
</DialogTrigger>
<DialogContent
showClose={false}
className="space-y-6"
containerClass="w-full max-w-md"
>
<h2 className="h4">
Install &ldquo;{getAppName(docket)}&rdquo;
</h2>
<p className="pr-6 tracking-tight">
This application will be able to view and interact with the
contents of your Urbit. Only install if you trust the
developer.
</p>
<div className="flex space-x-6">
<DialogClose asChild>
<Button variant="secondary">Cancel</Button>
</DialogClose>
<DialogClose asChild onClick={installApp}>
<Button onClick={installApp}>
Get &ldquo;{getAppName(docket)}&rdquo;
</Button>
</DialogClose>
</div>
</DialogContent>
</Dialog>
<Dialog.Portal>
<Dialog.Overlay className="fixed top-0 bottom-0 left-0 right-0 z-[60] transform-gpu bg-black opacity-30" />
<DialogContent
showClose={false}
className="space-y-6"
containerClass="w-full max-w-md z-[70]"
>
<h2 className="h4">
Install &ldquo;{getAppName(docket)}&rdquo;
</h2>
<p className="pr-6 tracking-tight">
This application will be able to view and interact with the
contents of your Urbit. Only install if you trust the
developer.
</p>
<div className="flex space-x-6">
<DialogClose asChild>
<Button variant="secondary">Cancel</Button>
</DialogClose>
<DialogClose asChild>
<Button onClick={installApp}>
Get &ldquo;{getAppName(docket)}&rdquo;
</Button>
</DialogClose>
</div>
</DialogContent>
</Dialog.Portal>
</Dialog.Root>
)}
<PillButton variant="alt-secondary" onClick={copyApp}>
{!copied && 'Copy App Link'}

7
ui/src/components/Dialog.tsx
View File

@ -1,6 +1,5 @@
import React, { FC } from 'react';
import * as DialogPrimitive from '@radix-ui/react-dialog';
import type * as Polymorphic from '@radix-ui/react-polymorphic';
import classNames from 'classnames';
export const Dialog: FC<DialogPrimitive.DialogProps> = ({
@ -9,8 +8,10 @@ export const Dialog: FC<DialogPrimitive.DialogProps> = ({
}) => {
return (
<DialogPrimitive.Root {...props}>
<DialogPrimitive.Overlay className="fixed top-0 bottom-0 left-0 right-0 z-30 transform-gpu bg-black opacity-30" />
{children}
<DialogPrimitive.Portal>
<DialogPrimitive.Overlay className="fixed top-0 bottom-0 left-0 right-0 z-30 transform-gpu bg-black opacity-30" />
{children}
</DialogPrimitive.Portal>
</DialogPrimitive.Root>
);
};

64
ui/src/components/LandscapeWayfinding.tsx
View File

@ -2,9 +2,9 @@ import React, { useState } from 'react';
import * as Dropdown from '@radix-ui/react-dropdown-menu';
import { setCalmSetting } from '../state/settings';
import { Dialog, DialogContent } from './Dialog';
import { Button } from './Button';
import { useCharges } from '../state/docket';
import { GroupLink } from './GroupLink';
import WayfindingAppLink from './WayfindingAppLink';
interface Group {
title: string;
@ -14,14 +14,6 @@ interface Group {
link: string;
}
interface App {
title: string;
description: string;
image: string;
color: string;
link: string;
}
const groups: Record<string, Group> = {
foundation: {
title: 'Urbit Foundation',
@ -46,35 +38,6 @@ const groups: Record<string, Group> = {
},
};
const AppLink = ({ link, title, description, image, color }: App) => {
return (
<div className="flex items-center justify-between py-2">
<div className="flex items-center space-x-2">
{image !== '' ? (
<img
src={image}
className="h-8 w-8 rounded"
style={{ backgroundColor: color }}
/>
) : (
<div className="h-8 w-8 rounded" style={{ backgroundColor: color }} />
)}
<div className="flex flex-col">
<span className="font-semibold">{title}</span>
{description && (
<span className="text-sm font-semibold text-gray-400">
{description}
</span>
)}
</div>
</div>
<Button variant="alt-primary" as="a" href={link} target="_blank">
Open App
</Button>
</div>
);
};
function LandscapeDescription() {
const charges = useCharges();
return (
@ -92,26 +55,35 @@ function LandscapeDescription() {
software developer, like “~paldev”.
</p>
<div className="mt-8 space-y-2">
<AppLink
<WayfindingAppLink
title="Groups"
description="Build or join Urbit-based communities"
link="/apps/groups"
image={charges.groups?.image || ''}
color={charges.groups?.color || 'bg-gray'}
installed={charges['groups'] ? true : false}
source="~sogryp-dister-dozzod-dozzod"
desk="groups"
/>
<AppLink
<WayfindingAppLink
title="Talk"
description="Simple instant messaging app"
link="/apps/talk"
image={charges.talk?.image || ''}
color={charges.talk?.color || 'bg-blue'}
installed={charges['talk'] ? true : false}
source="~sogryp-dister-dozzod-dozzod"
desk="talk"
/>
<AppLink
<WayfindingAppLink
title="Terminal"
description="Pop open the hood of your urbit"
link="/apps/webterm"
image={charges.webterm?.image || ''}
color={charges.webterm?.color || 'bg-black'}
installed={charges['terminal'] ? true : false}
source="~mister-dister-dozzod-dozzod"
desk="terminal"
/>
</div>
<h1 className="my-8 text-2xl font-bold">Where are the people?</h1>
@ -146,7 +118,11 @@ function LandscapeDescription() {
);
}
export default function LandscapeWayfinding() {
export default function LandscapeWayfinding({
className,
}: {
className?: string;
}) {
const [showModal, setShowModal] = useState(false);
const handleHide = () => {
@ -155,9 +131,9 @@ export default function LandscapeWayfinding() {
return (
<Dropdown.Root>
<div className="absolute left-4 bottom-16 z-50">
<div className={className}>
<Dropdown.Trigger className="relative" asChild>
<button className="h-9 w-9 cursor-pointer rounded-lg bg-black text-xl text-white">
<button className="h-8 w-8 cursor-pointer rounded-lg bg-black text-xl text-white sm:h-9 sm:w-9">
?
</button>
</Dropdown.Trigger>

7
ui/src/components/PikeMeta.tsx
View File

@ -8,8 +8,8 @@ export function PikeMeta(props: { pike: Pike }) {
const pluralUpdates = pike.wefts?.length !== 1;
return (
<div className="mt-5 sm:mt-8 space-y-5 sm:space-y-8">
<Attribute title="Desk Hash" attr="hash">
<div className="mt-5 space-y-5 sm:mt-8 sm:space-y-8">
<Attribute title="Desk Hash" attr="hash" className="break-all">
{pike.hash}
</Attribute>
<Attribute title="Installed into" attr="local-desk">
@ -17,7 +17,8 @@ export function PikeMeta(props: { pike: Pike }) {
</Attribute>
{pike.wefts && pike.wefts.length > 0 ? (
<Attribute attr="next" title="Pending Updates">
{pike.wefts.length} update{pluralUpdates ? 's are' : ' is'} pending a System Update
{pike.wefts.length} update{pluralUpdates ? 's are' : ' is'} pending a
System Update
</Attribute>
) : null}
</div>

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