urbit/shrub
1
1
Fork 0
mirror of https://github.com/urbit/shrub.git synced 2024-11-28 13:54:20 +03:00
Code Issues Packages Projects Releases Wiki Activity

Merge remote-tracking branch 'origin/na-release/candidate' into philip/testnet

Browse Source
This commit is contained in:
Philip Monk 2020-12-03 17:16:02 -08:00
commit 1213e298db
No known key found for this signature in database
GPG Key ID: B66E1F02604E44EC
75 changed files with 1797 additions and 1545 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
bin/brass.pill
View File

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

4
bin/ivory.pill
View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1
oid sha256:85a4e1625d528b5fdc88faeff4fd288a23d6fbf1c11a846fc8f8d5b3cd38370f
size 2118873
oid sha256:a2626da031efd3b1b7e743b86d62f959ea54274bf779d9dfb6fcd44dfc118092
size 2711173

4
bin/solid.pill
View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1
oid sha256:414730fedb33743a8e175344976784670be82ed9ba141f3ff4c23402377fe9a7
size 6958477
oid sha256:5402f3b52a34bda8a7189be0644bb6e31c738f358edc272ed4e542f597ed1c07
size 7294878

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

@ -767,7 +767,7 @@
:- %chat-view-action
!> ^- action:view
:* %create
(rsh 3 1 (spat path))
(rsh 3 (spat path))
''
real-path :: chat
group-path :: group

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

@ -515,7 +515,7 @@
:: correctly initialized, no need to do cleanup
::
~
?. =((end 3 4 i.t.path) 'dm--')
?. =((end [3 4] i.t.path) 'dm--')
~
:- =- [%pass /fixdm %agent [our.bol %chat-view] %poke %chat-view-action -]
!> ^- action:view

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

@ -362,7 +362,7 @@
(gth expiry-time.a expiry-time.b)
|= [cookie=@uv session:eyre]
%- pairs
:~ 'cookie'^s+(end 3 4 (rsh 3 2 (scot %x (shax cookie))))
:~ 'cookie'^s+(end [3 4] (rsh [3 2] (scot %x (shax cookie))))
'expiry'^(time expiry-time)
'channels'^(numb ~(wyt in channels))
==

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

@ -1249,7 +1249,7 @@
=/ advance (advance-hoon:auto typ p.q.q.p.u.q.vex)
=? res ?=(^ advance)
=/ to-send
(trip (rsh 3 (sub pos back-pos) u.advance))
(trip (rsh [3 (sub pos back-pos)] u.advance))
=| fxs=(list sole-effect)
=. .
|- ^+ +.$
@ -1340,7 +1340,7 @@
%+ murn ~(tap by dir:.^(arch %cy pax))
|= [=term ~]
^- (unit [^term tank])
?. =(app (end 3 (met 3 app) term))
?. =(app (end [3 (met 3 app)] term))
~
?~ =<(fil .^(arch %cy (weld pax ~[term %hoon])))
~
@ -1352,7 +1352,7 @@
%+ murn ~(tap by var)
|= [name=term =cage]
^- (unit [term tank])
?. =(variable (end 3 (met 3 variable) name))
?. =(variable (end [3 (met 3 variable)] name))
~
`[name (sell q.cage)]
::
@ -1371,7 +1371,7 @@
%+ murn
~(tap by dir:.^(arch %cy pfix))
|= [=term ~]
?. =(gen (end 3 (met 3 gen) term))
?. =(gen (end [3 (met 3 gen)] term))
~
?~ =<(fil .^(arch %cy (weld pfix ~[term %hoon])))
~
@ -1386,7 +1386,7 @@
%+ murn
~(tap by dir:.^(arch %cy pax))
|= [=term ~]
?. =(gen (end 3 (met 3 gen) term))
?. =(gen (end [3 (met 3 gen)] term))
~
?~ =<(fil .^(arch %cy (weld pax ~[term %hoon])))
~
@ -1403,7 +1403,7 @@
=/ back-pos
(sub pos (met 3 completing))
=/ to-send
(trip (rsh 3 (sub pos back-pos) advance))
(trip (rsh [3 (sub pos back-pos)] advance))
=| fxs=(list sole-effect)
::
:: Cursor is guaranteed to be at end so we don't worry about the

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

@ -234,7 +234,7 @@
?~ data
[not-found:gen %.n]
:_ public.u.content
=/ mime-type=@t (rsh 3 1 (crip <p.u.data>))
=/ mime-type=@t (rsh 3 (crip <p.u.data>))
:: Should maybe inspect to see how long cache should hold
::
[[200 ['content-type' mime-type] max-1-da:gen ~] `q.u.data]
@ -323,7 +323,7 @@
?+ path (on-peek:def path)
[%x %clay %base %hash ~]
=/ versions (base-hash:version [our now]:bowl)
``hash+!>(?~(versions 0v0 (end 0 25 i.versions)))
``hash+!>(?~(versions 0v0 (end [0 25] i.versions)))
==
++ on-agent on-agent:def
++ on-fail on-fail:def

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

@ -94,11 +94,11 @@
%- ~(rep by dir)
|= [[file=@t ~] out=(unit @t)]
?^ out out
?. ?& =((end 3 6 file) 'index.')
!=('sj.' (end 3 3 (swp 3 file)))
?. ?& =((end [3 6] file) 'index.')
!=('sj.' (end [3 3] (swp 3 file)))
==
out
``@t`(rsh 3 6 file)
``@t`(rsh [3 6] file)
=/ js-name
(cat 3 'index.' bundle-hash)
=/ map-name

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

@ -29,7 +29,7 @@
:: Modify the group. Further documented in /sur/group-store.hoon
::
::
/- *group, permission-store, *contact-view
/- *group, *contact-view
/+ store=group-store, default-agent, verb, dbug, resource, *migrate
|%
+$ card card:agent:gall

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

@ -72,7 +72,7 @@
|= [=mark =vase]
^- step:agent:gall
|^
=/ fin (end 3 4 mark)
=/ fin (end [3 4] mark)
?: =(%drum fin) poke-drum
?: =(%helm fin) poke-helm
?: =(%kiln fin) poke-kiln

2
pkg/arvo/gen/help.hoon
View File

@ -27,7 +27,7 @@
==
=/ c (to-wain:format a)
?~ c "~"
?. =(':: ' (end 3 4 i.c))
?. =(':: ' (end [3 4] i.c))
"<undocumented>"
(trip i.c)
::

2
pkg/arvo/gen/hood/claz-invites.hoon
View File

@ -28,7 +28,7 @@
%+ turn (gulf min-child max-child)
|= child=@ud
=/ who=ship (cat 4 star child)
=/ ticket=@q (end 3 8 (shas who eny))
=/ ticket=@q (end [3 8] (shas who eny))
=/ owner=address
=< addr.keys
::NOTE ~zod because invite wallet convention

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

@ -23,7 +23,7 @@
=/ mon=ship
?^ arg
mon.arg
(add our (lsh 5 1 (end 5 1 (shaz eny))))
(add our (lsh 5 (end 5 (shaz eny))))
=/ seg=ship (sein:title our now mon)
?. =(our seg)
%- %- slog :_ ~

8
pkg/arvo/gen/key.hoon
View File

@ -17,11 +17,11 @@
=/ cub (pit:nu:crub:crypto 512 bur)
::
=/ pub=pass pub:ex:cub
=/ mag=cord (end 3 1 pub)
=/ mag=cord (end 3 pub)
?> =('b' mag)
=/ bod=@ (rsh 3 1 pub)
=/ cry=@ (rsh 8 1 bod)
=/ sgn=@ (end 8 1 bod)
=/ bod=@ (rsh 3 pub)
=/ cry=@ (rsh 8 bod)
=/ sgn=@ (end 8 bod)
%+ print leaf+" authentication: 0x{(render-hex-bytes:ethereum 32 sgn)}"
%+ print leaf+" networking: 0x{(render-hex-bytes:ethereum 32 cry)}"
%+ print leaf+"ethereum public keys:"

4
pkg/arvo/gen/reload-event.hoon
View File

@ -16,10 +16,10 @@
?. =(1 (met 3 tam))
tam
=/ zaz=(list [p=knot ~])
(skim van |=([a=term ~] =(tam (end 3 1 a))))
(skim van |=([a=term ~] =(tam (end 3 a))))
?> ?=([[@ ~] ~] zaz)
`term`p.i.zaz
=/ tip (end 3 1 nam)
=/ tip (end 3 nam)
=/ bip ?:(=('z' tip) %$ tip)
=/ way ?:(=('z' tip) (welp top /sys/[nam]) (welp top /sys/vane/[nam]))
=/ fil .^(@ %cx (welp way /hoon))

6
pkg/arvo/lib/base64.hoon
View File

@ -33,7 +33,7 @@
=/ atom-word-width (div-ceil atom-bit-width wid)
=/ rslt-word-width (div-ceil octs-bit-width wid)
=/ pad (sub rslt-word-width atom-word-width)
=/ x (ripn wid q.octs)
=/ x (rip [0 wid] q.octs)
%+ weld x
(reap pad 0)
::
@ -67,7 +67,7 @@
++ octs-to-blocks
|= bs=octs ^- [padding=@ud (list word24)]
=/ padding=@ud (~(dif fo 3) 0 p.bs)
=/ padded=octs [(add padding p.bs) (lsh 3 padding (rev 3 bs))]
=/ padded=octs [(add padding p.bs) (lsh [3 padding] (rev 3 bs))]
[padding (explode-words 24 padded)]
::
++ unpad
@ -128,6 +128,6 @@
=/ len (sub (mul 3 (div (add lat dif) 4)) dif)
:+ ~ len
%+ swp 3
(repn 6 (flop (weld dat (reap dif 0))))
(rep [0 6] (flop (weld dat (reap dif 0))))
--
--

12
pkg/arvo/lib/bip32.hoon
View File

@ -56,8 +56,8 @@
++ take
|= b=@ud
^- [v=@ x=@]
:- (end 3 b x)
(rsh 3 b x)
:- (end [3 b] x)
(rsh [3 b] x)
--
=^ k x (take 33)
=^ c x (take 32)
@ -173,7 +173,7 @@
^- @uc
:: removes checksum
::
%^ rsh 3 4
%+ rsh [3 4]
%+ en-base58check
[4 (version-bytes network %pub %.n)]
[20 identity]
@ -211,15 +211,15 @@
|= [v=byts d=byts]
=+ p=[(add wid.v wid.d) (can 3 ~[d v])]
=- (can 3 ~[4^- p])
%^ rsh 3 28
%+ 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))
=+ 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

6
pkg/arvo/lib/bip39.hoon
View File

@ -12,7 +12,7 @@
::
=+ cs=(div wid 32)
=/ check=@
%^ rsh 0 (sub 256 cs)
%+ rsh [0 (sub 256 cs)]
(sha-256l:sha (div wid 8) dat)
=/ bits=byts
:- (add wid cs)
@ -23,9 +23,9 @@
::
=/ pieces
|- ^- (list @)
:- (end 0 11 dat.bits)
:- (end [0 11] dat.bits)
?: (lte wid.bits 11) ~
$(bits [(sub wid.bits 11) (rsh 0 11 dat.bits)])
$(bits [(sub wid.bits 11) (rsh [0 11] dat.bits)])
::
=/ words=(list tape)
%+ turn pieces

6
pkg/arvo/lib/der.hoon
View File

@ -142,10 +142,10 @@
++ bit
|= [len=@ud dat=@ux]
^- (unit [len=@ud dat=@ux])
?. =(0 (end 3 1 dat)) ~
?. =(0 (end 3 dat)) ~
:+ ~
(mul 8 (dec len))
(rsh 3 1 dat)
(rsh 3 dat)
:: +recur:parse:der: parse bytes for a list of +spec:asn1
::
++ recur
@ -188,7 +188,7 @@
=/ [nex=@ len=@]
:: faz: meaningful bits in fuz
::
=/ faz (end 0 7 fuz)
=/ faz (end [0 7] fuz)
?: =(0 (cut 0 [7 1] fuz))
[0 faz]
[faz (rep 3 (flop (scag faz t.q.tub)))]

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

@ -1045,7 +1045,7 @@
%+ welp
cad.pom
?~ buf.say.inp ~
:(welp "<" (scow %p (end 4 1 (sham buf.say.inp))) "> ")
:(welp "<" (scow %p (end 4 (sham buf.say.inp))) "> ")
::
++ ta-yan :: yank
(snag (sub num.kil pos.kil) old.kil)

4
pkg/arvo/lib/hood/helm.hoon
View File

@ -168,10 +168,10 @@
?. =(1 (met 3 nam))
nam
=/ zaz=(list [p=knot ~])
(skim van |=([a=term ~] =(nam (end 3 1 a))))
(skim van |=([a=term ~] =(nam (end 3 a))))
?> ?=([[@ ~] ~] zaz)
`term`p.i.zaz
=+ tip=(end 3 1 nam)
=+ tip=(end 3 nam)
=+ zus==('z' tip)
=+ way=?:(zus (welp top /sys/[nam]) (welp top /sys/vane/[nam]))
=+ fil=.^(@ %cx (welp way /hoon))

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

@ -96,11 +96,11 @@
=+ =< [pub=pub:ex sec=sec:ex]
(pit:nu:crub:crypto 256 seed)
:- ^= auth
:- (rsh 3 1 (end 3 33 pub))
(rsh 3 1 (end 3 33 sec))
:- (rsh 3 (end [3 33] pub))
(rsh 3 (end [3 33] sec))
^= crypt
:- (rsh 3 33 pub)
(rsh 3 33 sec)
:- (rsh [3 33] pub)
(rsh [3 33] sec)
::
++ seed
|= [seed=byts salt=tape]

10
pkg/arvo/lib/language-server/complete.hoon
View File

@ -87,7 +87,7 @@
%+ skim ids
|= [id=cord *]
^- ?(%.y %.n)
=(sid (end 3 (met 3 sid) id))
=(sid (end [3 (met 3 sid)] id))
::
:: Get the longest prefix of a list of identifiers.
::
@ -101,14 +101,14 @@
|- ^- term
?: (gth n last)
term.i.matches
=/ prefix (end 3 n term.i.matches)
=/ prefix (end [3 n] term.i.matches)
?: |- ^- ?
?| ?=(~ t.matches)
?& =(prefix (end 3 n term.i.t.matches))
?& =(prefix (end [3 n] term.i.t.matches))
$(t.matches t.t.matches)
== ==
$(n +(n))
(end 3 (dec n) term.i.matches)
(end [3 (dec n)] term.i.matches)
::
:: Run +find-type safely, printing the first line of the stack trace on
:: error.
@ -369,7 +369,7 @@
:- %leaf
=/ c (to-wain:format a)
?~ c "~"
?. =(':: ' (end 3 4 i.c))
?. =(':: ' (end [3 4] i.c))
"<undocumented>"
(trip i.c)
--

2
pkg/arvo/lib/language-server/easy-print.hoon
View File

@ -39,7 +39,7 @@
['\\' i.mil $(mil t.mil)]
?: (lte ' ' i.mil)
[i.mil $(mil t.mil)]
['\\' ~(x ne (rsh 2 1 i.mil)) ~(x ne (end 2 1 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

10
pkg/arvo/lib/old-phon.hoon
View File

@ -88,9 +88,9 @@
::
++ mu
|_ [top=@ bot=@]
++ zag [p=(end 4 1 (add top bot)) q=bot]
++ zig [p=(end 4 1 (add top (sub 0x1.0000 bot))) q=bot]
++ zug (mix (lsh 4 1 top) bot)
++ zag [p=(end 4 (add top bot)) q=bot]
++ zig [p=(end 4 (add top (sub 0x1.0000 bot))) q=bot]
++ zug (mix (lsh 4 top) bot)
--
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
:: section 2eN, pseudo-cryptography ::
@ -111,7 +111,7 @@
?: =(0 len)
~
=> .(len (dec len))
=+ mog=(zyft :(mix mig (end 3 1 len) (cut 3 [len 1] pyn)))
=+ mog=(zyft :(mix mig (end 3 len) (cut 3 [len 1] pyn)))
[[1 mog] $(mig mog)]
::
++ wred :: restore structure
@ -129,7 +129,7 @@
~
=> .(len (dec len))
=+ mog=(cut 3 [len 1] cry)
[[1 :(mix mig (end 3 1 len) (zyrt mog))] $(mig mog)]
[[1 :(mix mig (end 3 len) (zyrt mog))] $(mig mog)]
::
++ xafo |=([a=@ b=@] +((mod (add (dec b) a) 255)))
++ xaro |=([a=@ b=@] +((mod (add (dec b) (sub 255 (mod a 255))) 255)))

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

@ -62,7 +62,7 @@
|- ^- wain
?~ a
[(rap 3 ['-----END ' lab '-----' ~]) ~]
[(end 3 64 a) $(a (rsh 3 64 a))]
[(end [3 64] a) $(a (rsh [3 64] a))]
:: +de:pem: PEM decode
::
++ de

4
pkg/arvo/lib/primitive-rsa.hoon
View File

@ -36,7 +36,7 @@
:: 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))
=/ 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))))
@ -55,7 +55,7 @@
=/ e `@ux`65.537
|= [wid=@ eny=@]
^- key
=/ diw (rsh 0 1 wid)
=/ diw (rsh 0 wid)
=/ p=@ux (ramp diw [3 5 ~] eny)
=/ q=@ux (ramp diw [3 5 ~] +(eny))
=/ n=@ux (mul p q)

12
pkg/arvo/lib/ring.hoon
View File

@ -321,26 +321,26 @@
++ seed-to-private-key-scalar
|= sk=@I ^- @udscalar
?: (gth (met 3 sk) 32) !!
=+ h=(shal (rsh 0 3 b:ed:crypto) sk)
=+ 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))
(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 1 a) bod=(rsh 3 1 a)]
=+ [mag=(end 3 a) bod=(rsh 3 a)]
~| %not-crub-pubkey ?> =('b' mag)
[cry=(rsh 8 1 bod) sgn=(end 8 1 bod)]
[cry=(rsh 8 bod) sgn=(end 8 bod)]
::
::
++ get-private-key-from-ring
|= a=ring
^- [@ @]
=+ [mag=(end 3 1 a) bod=(rsh 3 1 a)]
=+ [mag=(end 3 a) bod=(rsh 3 a)]
~| %not-crub-seckey ?> =('B' mag)
=+ [c=(rsh 8 1 bod) s=(end 8 1 bod)]
=+ [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

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

@ -302,7 +302,7 @@
(longest-match:auto options)
=/ to-send=tape
%- trip
(rsh 3 (met 3 needle) advance)
(rsh [3 (met 3 needle)] advance)
=/ send-pos=@ud
%+ add pos
(met 3 (fall forward ''))

2
pkg/arvo/lib/test/runner.hoon
View File

@ -101,6 +101,6 @@
::
++ has-test-prefix
|= a=term ^- ?
=((end 3 5 a) 'test-')
=((end [3 5] a) 'test-')
--

13
pkg/arvo/mar/blit.hoon
View File

@ -48,10 +48,15 @@
::
:- 'stye'
%- pairs
:~ 'back'^[?~(. ~ s+.)]:p.q.stye
'fore'^[?~(. ~ s+.)]:q.q.stye
'deco'^a+(turn ~(tap in p.stye) |=(d=deco ?~(d ~ s+d)))
==
|^ :~ '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)))
--
==
==
--

2
pkg/arvo/mar/eth/txs.hoon
View File

@ -10,7 +10,7 @@
%- cook :_ nuck:so
|= =coin
?> ?=(%$ -.coin)
?> ?=(%u (end 3 1 p.p.coin))
?> ?=(%u (end 3 p.p.coin))
`@`q.p.coin
::
++ grab

2
pkg/arvo/mar/hash.hoon
View File

@ -5,7 +5,7 @@
|%
++ noun hash
++ json
s+(rsh 3 2 (scot %uv hash))
s+(rsh [3 2] (scot %uv hash))
--
++ grab
|%

2
pkg/arvo/mar/udon.hoon
View File

@ -17,7 +17,7 @@
^- (map term knot)
%- ~(run by inf:(static:cram (ream mud)))
|= a=dime ^- cord
?+ (end 3 1 p.a) (scot a)
?+ (end 3 p.a) (scot a)
%t q.a
==
--

2
pkg/arvo/mar/umd.hoon
View File

@ -17,7 +17,7 @@
^- (map term knot)
%- ~(run by inf:(static:cram (ream mud)))
|= a=dime ^- cord
?+ (end 3 1 p.a) (scot a)
?+ (end 3 p.a) (scot a)
%t q.a
==
--

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

@ -1076,7 +1076,7 @@
%+ turn von
=/ bem=beam [[our %home da+now] /whey]
|= [lal=@tas =vane]
=/ met (peek ~ (rsh 3 5 lal) bem)
=/ met (peek ~ (rsh [3 5] lal) bem)
?> &(?=(^ met) ?=(^ u.met)) :: XX make optional
lal^|+;;((list mass) q.q.u.u.met)
::
@ -1100,8 +1100,8 @@
::
:: XX vane and care are concatenated
::
=/ lal (end 3 1 cyr)
=/ ren ;;(@t (rsh 3 1 cyr))
=/ lal (end 3 cyr)
=/ ren ;;(@t (rsh 3 cyr))
?. (~(has by van.mod) lal)
~
(peek:(plow lal) lyc ren bem)

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

@ -269,6 +269,12 @@
::
:: the most basic of data types
+| %containers
::
+$ bite
:: atom slice specifier
::
$@(bloq [=bloq =step])
::
+$ bloq
:: blocksize
::
@ -368,6 +374,11 @@
::
[(list item) state]
::
++ step
:: atom size or offset, in bloqs
::
_`@u`1
::
++ trap
|$ [product]
:: a core with one arm `$`
@ -821,46 +832,50 @@
::
++ bex :: binary exponent
~/ %bex
|= a=@
|= a=bloq
^- @
?: =(0 a) 1
(mul 2 $(a (dec a)))
::
++ can :: assemble
~/ %can
|= [a=bloq b=(list [p=@u q=@])]
|= [a=bloq b=(list [p=step q=@])]
^- @
?~ b 0
(add (end a p.i.b q.i.b) (lsh a p.i.b $(b t.b)))
(add (end [a p.i.b] q.i.b) (lsh [a p.i.b] $(b t.b)))
::
++ cat :: concatenate
~/ %cat
|= [a=bloq b=@ c=@]
(add (lsh a (met a b) c) b)
(add (lsh [a (met a b)] c) b)
::
++ cut :: slice
~/ %cut
|= [a=bloq [b=@u c=@u] d=@]
(end a c (rsh a b d))
|= [a=bloq [b=step c=step] d=@]
(end [a c] (rsh [a b] d))
::
++ end :: tail
~/ %end
|= [a=bloq b=@u c=@]
(mod c (bex (mul (bex a) b)))
|= [a=bite b=@]
=/ [=bloq =step] ?^(a a [a *step])
(mod b (bex (mul (bex bloq) step)))
::
++ fil :: fill bloqstream
|= [a=bloq b=@u c=@]
=+ n=0
=+ d=c
~/ %fil
|= [a=bloq b=step c=@]
=| n=@ud
=. c (end a c)
=/ d c
|- ^- @
?: =(n b)
(rsh a 1 d)
$(d (add c (lsh a 1 d)), n +(n))
(rsh a d)
$(d (add c (lsh a d)), n +(n))
::
++ lsh :: left-shift
~/ %lsh
|= [a=bloq b=@u c=@]
(mul (bex (mul (bex a) b)) c)
|= [a=bite b=@]
=/ [=bloq =step] ?^(a a [a *step])
(mul b (bex (mul (bex bloq) step)))
::
++ met :: measure
~/ %met
@ -869,32 +884,24 @@
=+ c=0
|-
?: =(0 b) c
$(b (rsh a 1 b), c +(c))
$(b (rsh a b), c +(c))
::
++ rap :: assemble nonzero
++ rap :: assemble variable
~/ %rap
|= [a=bloq b=(list @)]
^- @
=+ ~ ::REMOVEME jet dashboard bump
?~ b 0
(cat a i.b $(b t.b))
::
++ rep :: assemble single
++ rep :: assemble fixed
~/ %rep
|= [a=bloq b=(list @)]
^- @
=+ c=0
|-
?~ b 0
(add (lsh a c (end a 1 i.b)) $(c +(c), b t.b))
::
++ repn
~/ %repn
|= [bits=@ud x=(list @)]
=| c=@ud
|= [a=bite b=(list @)]
=/ [=bloq =step] ?^(a a [a *step])
=| i=@ud
|- ^- @
?~ x 0
(add (lsh 0 (mul bits c) (end 0 bits i.x)) $(c +(c), x t.x))
?~ b 0
%+ add $(i +(i), b t.b)
(lsh [bloq (mul step i)] (end [bloq step] i.b))
::
++ rev
:: reverses block order, accounting for leading zeroes
@ -905,31 +912,42 @@
~/ %rev
|= [boz=bloq len=@ud dat=@]
^- @
=. dat (end boz len dat)
%^ lsh boz
(sub len (met boz dat))
=. dat (end [boz len] dat)
%+ lsh
[boz (sub len (met boz dat))]
(swp boz dat)
::
:: Like `rip` but produces n-bit blocks instead of 2^n bit blocks.
::
++ ripn
~/ %ripn
|= [bits=@ud x=@]
^- (list @)
?: =(0 x) ~
[(end 0 bits x) $(x (rsh 0 bits x))]
::
++ rip :: disassemble
~/ %rip
|= [=bloq x=@]
|= [a=bite b=@]
^- (list @)
?: =(0 x) ~
[(end bloq 1 x) $(x (rsh bloq 1 x))]
?: =(0 b) ~
[(end a b) $(b (rsh a b))]
::
++ rsh :: right-shift
~/ %rsh
|= [a=bloq b=@u c=@]
(div c (bex (mul (bex a) b)))
|= [a=bite b=@]
=/ [=bloq =step] ?^(a a [a *step])
(div b (bex (mul (bex bloq) step)))
::
++ run :: +turn into atom
~/ %run
|= [a=bite b=@ c=$-(@ @)]
(rep a (turn (rip a b) c))
::
++ rut :: +turn into list
~/ %rut
|* [a=bite b=@ c=$-(@ *)]
(turn (rip a b) c)
::
++ sew :: stitch into
~/ %sew
|= [a=bloq [b=step c=step d=@] e=@]
^- @
%+ add
(can a b^e c^d ~)
=/ f [a (add b c)]
(lsh f (rsh f e))
::
++ swp :: naive rev bloq order
~/ %swp
@ -953,21 +971,21 @@
b
=+ c=(dec a)
%+ con
(lsh c 1 $(a c, b (cut c [0 1] b)))
(lsh c $(a c, b (cut c [0 1] b)))
$(a c, b (cut c [1 1] b))
++ out (bex (bex a)) :: mod value
++ rol |= [b=bloq c=@ d=@] ^- @ :: roll left
=+ e=(sit d)
=+ f=(bex (sub a b))
=+ g=(mod c f)
(sit (con (lsh b g e) (rsh b (sub f g) e)))
(sit (con (lsh [b g] e) (rsh [b (sub f g)] e)))
++ ror |= [b=bloq c=@ d=@] ^- @ :: roll right
=+ e=(sit d)
=+ f=(bex (sub a b))
=+ g=(mod c f)
(sit (con (rsh b g e) (lsh b (sub f g) e)))
(sit (con (rsh [b g] e) (lsh [b (sub f g)] e)))
++ sum |=([b=@ c=@] (sit (add b c))) :: wrapping add
++ sit |=(b=@ (end a 1 b)) :: enforce modulo
++ sit |=(b=@ (end a b)) :: enforce modulo
--
:: ::
:::: 2d: bit logic ::
@ -980,13 +998,13 @@
|- ^- @
?: ?&(=(0 a) =(0 b)) d
%= $
a (rsh 0 1 a)
b (rsh 0 1 b)
a (rsh 0 a)
b (rsh 0 b)
c +(c)
d %+ add d
%^ lsh 0 c
?& =(0 (end 0 1 a))
=(0 (end 0 1 b))
%+ lsh [0 c]
?& =(0 (end 0 a))
=(0 (end 0 b))
==
==
::
@ -997,13 +1015,13 @@
|- ^- @
?: ?|(=(0 a) =(0 b)) d
%= $
a (rsh 0 1 a)
b (rsh 0 1 b)
a (rsh 0 a)
b (rsh 0 b)
c +(c)
d %+ add d
%^ lsh 0 c
?| =(0 (end 0 1 a))
=(0 (end 0 1 b))
%+ lsh [0 c]
?| =(0 (end 0 a))
=(0 (end 0 b))
==
==
::
@ -1015,10 +1033,10 @@
|-
?: ?&(=(0 a) =(0 b)) d
%= $
a (rsh 0 1 a)
b (rsh 0 1 b)
a (rsh 0 a)
b (rsh 0 b)
c +(c)
d (add d (lsh 0 c =((end 0 1 a) (end 0 1 b))))
d (add d (lsh [0 c] =((end 0 a) (end 0 b))))
==
::
++ not |= [a=bloq b=@ c=@] :: binary not (sized)
@ -1031,7 +1049,7 @@
~% %muk ..muk ~
=+ ~(. fe 5)
|= [syd=@ len=@ key=@]
=. syd (end 5 1 syd)
=. syd (end 5 syd)
=/ pad (sub len (met 3 key))
=/ data (weld (rip 3 key) (reap pad 0))
=/ nblocks (div len 4) :: intentionally off-by-one
@ -1054,14 +1072,14 @@
=/ tlen (dis len 3)
=. h1
?+ tlen h1 :: fallthrough switch
%3 =. k1 (mix k1 (lsh 0 16 (snag 2 tail)))
=. k1 (mix k1 (lsh 0 8 (snag 1 tail)))
%3 =. k1 (mix k1 (lsh [0 16] (snag 2 tail)))
=. k1 (mix k1 (lsh [0 8] (snag 1 tail)))
=. k1 (mix k1 (snag 0 tail))
=. k1 (sit (mul k1 c1))
=. k1 (rol 0 15 k1)
=. k1 (sit (mul k1 c2))
(mix h1 k1)
%2 =. k1 (mix k1 (lsh 0 8 (snag 1 tail)))
%2 =. k1 (mix k1 (lsh [0 8] (snag 1 tail)))
=. k1 (mix k1 (snag 0 tail))
=. k1 (sit (mul k1 c1))
=. k1 (rol 0 15 k1)
@ -1077,11 +1095,11 @@
|^ (fmix32 h1)
++ fmix32
|= h=@
=. h (mix h (rsh 0 16 h))
=. h (mix h (rsh [0 16] h))
=. h (sit (mul h 0x85eb.ca6b))
=. h (mix h (rsh 0 13 h))
=. h (mix h (rsh [0 13] h))
=. h (sit (mul h 0xc2b2.ae35))
=. h (mix h (rsh 0 16 h))
=. h (mix h (rsh [0 16] h))
h
--
::
@ -1099,7 +1117,7 @@
|- ^- @F
?: =(8 i) fal
=/ haz=@F (muk syd wyd key)
=/ ham=@F (mix (rsh 0 31 haz) (end 0 31 haz))
=/ ham=@F (mix (rsh [0 31] haz) (end [0 31] haz))
?.(=(0 ham) ham $(i +(i), syd +(syd)))
--
:: ::
@ -1123,9 +1141,9 @@
$(a -.a, b -.b)
?. ?=(@ b) &
|-
=+ [c=(end 3 1 a) d=(end 3 1 b)]
=+ [c=(end 3 a) d=(end 3 b)]
?: =(c d)
$(a (rsh 3 1 a), b (rsh 3 1 b))
$(a (rsh 3 a), b (rsh 3 b))
(lth c d)
:: +dor: depth order
::
@ -2044,16 +2062,16 @@
=> .(m (~(put by m) a b))
?: ?=(@ a)
=+ d=(mat a)
[(add 1 p.d) (lsh 0 1 q.d) m]
[(add 1 p.d) (lsh 0 q.d) m]
=> .(b (add 2 b))
=+ d=$(a -.a)
=+ e=$(a +.a, b (add b p.d), m r.d)
[(add 2 (add p.d p.e)) (mix 1 (lsh 0 2 (cat 0 q.d q.e))) r.e]
[(add 2 (add p.d p.e)) (mix 1 (lsh [0 2] (cat 0 q.d q.e))) r.e]
?: ?&(?=(@ a) (lte (met 0 a) (met 0 u.c)))
=+ d=(mat a)
[(add 1 p.d) (lsh 0 1 q.d) m]
[(add 1 p.d) (lsh 0 q.d) m]
=+ d=(mat u.c)
[(add 2 p.d) (mix 3 (lsh 0 2 q.d)) m]
[(add 2 p.d) (mix 3 (lsh [0 2] q.d)) m]
::
++ mat :: length-encode
~/ %mat
@ -2064,7 +2082,7 @@
=+ b=(met 0 a)
=+ c=(met 0 b)
:- (add (add c c) b)
(cat 0 (bex c) (mix (end 0 (dec c) b) (lsh 0 (dec c) a)))
(cat 0 (bex c) (mix (end [0 (dec c)] b) (lsh [0 (dec c)] a)))
::
++ rub :: length-decode
~/ %rub
@ -2156,9 +2174,9 @@
|= [b=@ c=@]
?: =(0 b)
1
=+ d=$(b (rsh 0 1 b))
=+ d=$(b (rsh 0 b))
=+ e=(pro d d)
?:(=(0 (end 0 1 b)) e (pro c e))
?:(=(0 (end 0 b)) e (pro c e))
::
++ fra
|= [b=@ c=@]
@ -2185,7 +2203,7 @@
++ si :: signed integer
^?
|%
++ abs |=(a=@s (add (end 0 1 a) (rsh 0 1 a))) :: absolute value
++ abs |=(a=@s (add (end 0 a) (rsh 0 a))) :: absolute value
++ dif |= [a=@s b=@s] :: subtraction
(sum a (new !(syn b) (abs b)))
++ dul |= [a=@s b=@] :: modulus
@ -2212,7 +2230,7 @@
(new & (sub +.d +.c))
(new | (add +.c +.d))
++ sun |=(a=@u (mul 2 a)) :: @u to @s
++ syn |=(a=@s =(0 (end 0 1 a))) :: sign test
++ syn |=(a=@s =(0 (end 0 a))) :: sign test
++ cmp |= [a=@s b=@s] :: compare
^- @s
?: =(a b)
@ -2264,7 +2282,7 @@
=+ q=(dif:si e.a e.b)
|- ?. (syn:si q) $(b a, a b, q +(q)) :: a has larger exp
?: e
[%f & e.b (^add (lsh 0 (abs:si q) a.a) a.b)]
[%f & e.b (^add (lsh [0 (abs:si q)] a.a) a.b)]
=+ [ma=(met 0 a.a) mb=(met 0 a.b)]
=+ ^= w %+ dif:si e.a %- sun:si :: expanded exp of a
?: (gth prc ma) (^sub prc ma) 0
@ -2275,7 +2293,7 @@
%a (lug %lg a &) %u (lug %lg a &)
%n (lug %na a &)
==
(rou [e.b (^add (lsh 0 (abs:si q) a.a) a.b)])
(rou [e.b (^add (lsh [0 (abs:si q)] a.a) a.b)])
::
++ sub :: subtract; exact if e
|= [a=[e=@s a=@u] b=[e=@s a=@u] e=?] ^- fn
@ -2292,7 +2310,7 @@
%a (lug %ce a &) %u (lug %ce a &)
%n (lug %nt a &)
==
=+ j=(lsh 0 (abs:si q) a.a)
=+ j=(lsh [0 (abs:si q)] a.a)
|- ?. (gte j a.b)
(fli $(a.b j, j a.b, r swr))
=+ i=(^sub j a.b)
@ -2308,7 +2326,7 @@
=+ [ma=(met 0 a.a) mb=(met 0 a.b)]
=+ v=(dif:si (sun:si ma) (sun:si +((^add mb prc))))
=. a ?: (syn:si v) a
a(e (sum:si v e.a), a (lsh 0 (abs:si v) a.a))
a(e (sum:si v e.a), a (lsh [0 (abs:si v)] a.a))
=+ [j=(dif:si e.a e.b) q=(dvr a.a a.b)]
(rau [j p.q] =(q.q 0))
::
@ -2319,7 +2337,7 @@
=+ ?:((^lth w x) (^sub x w) 0)
=+ ?: =((dis - 1) (dis (abs:si e.a) 1)) -
(^add - 1)
a(e (dif:si e.a (sun:si -)), a (lsh 0 - a.a))
a(e (dif:si e.a (sun:si -)), a (lsh [0 -] a.a))
=+ [y=(^sqt a.a) z=(fra:si e.a --2)]
(rau [z p.y] =(q.y 0))
::
@ -2329,15 +2347,15 @@
=+ c=(cmp:si (ibl a) (ibl b))
?: =(c -1) & ?: =(c --1) |
?: =((cmp:si e.a e.b) -1)
(^lth (rsh 0 (abs:si (dif:si e.a e.b)) a.a) a.b)
(^lth (lsh 0 (abs:si (dif:si e.a e.b)) a.a) a.b)
(^lth (rsh [0 (abs:si (dif:si e.a e.b))] a.a) a.b)
(^lth (lsh [0 (abs:si (dif:si e.a e.b))] a.a) a.b)
::
++ equ :: equals
|= [a=[e=@s a=@u] b=[e=@s a=@u]] ^- ?
?. =((ibl a) (ibl b)) |
?: =((cmp:si e.a e.b) -1)
=((lsh 0 (abs:si (dif:si e.a e.b)) a.b) a.a)
=((lsh 0 (abs:si (dif:si e.a e.b)) a.a) a.b)
=((lsh [0 (abs:si (dif:si e.a e.b))] a.b) a.a)
=((lsh [0 (abs:si (dif:si e.a e.b))] a.a) a.b)
::
:: integer binary logarithm: 2^ibl(a) <= |a| < 2^(ibl(a)+1)
++ ibl
@ -2348,8 +2366,8 @@
:: every fn has a unique representation of this kind
++ uni
|= [a=[e=@s a=@u]]
|- ?: =((end 0 1 a.a) 1) a
$(a.a (rsh 0 1 a.a), e.a (sum:si e.a --1))
|- ?: =((end 0 a.a) 1) a
$(a.a (rsh 0 a.a), e.a (sum:si e.a --1))
::
:: expands to either full precision or to denormalized
++ xpd
@ -2361,7 +2379,7 @@
=+ w=(dif:si e.a emn)
?: (syn:si w) (abs:si w) 0
(min q (^sub prc ma))
a(e (dif:si e.a (sun:si -)), a (lsh 0 - a.a))
a(e (dif:si e.a (sun:si -)), a (lsh [0 -] a.a))
::
:: central rounding mechanism
:: can perform: floor, ceiling, smaller, larger,
@ -2383,8 +2401,8 @@
?: (gth m prc) (^sub m prc) 0 :: reduce precision
%- abs:si ?: =(den %i) --0 :: enforce min. exp
?: =((cmp:si e.a emn) -1) (dif:si emn e.a) --0
=^ b a :- (end 0 q a.a)
a(e (sum:si e.a (sun:si q)), a (rsh 0 q a.a))
=^ b a :- (end [0 q] a.a)
a(e (sum:si e.a (sun:si q)), a (rsh [0 q] a.a))
::
?~ a.a
?< =(den %i)
@ -2427,7 +2445,7 @@
==
::
=. a ?. =((met 0 a.a) +(prc)) a
a(a (rsh 0 1 a.a), e (sum:si e.a --1))
a(a (rsh 0 a.a), e (sum:si e.a --1))
?~ a.a [%f & zer]
::
?: =(den %i) [%f & a]
@ -2438,9 +2456,9 @@
|= [a=[e=@s a=@u]] ^- [@s @u] :: guaranteed accurate
?< =(a.a 0) :: for rounded floats
=. a (xpd a)
=+ r=(lsh 0 ?:((syn:si e.a) (abs:si e.a) 0) a.a)
=+ s=(lsh 0 ?.((syn:si e.a) (abs:si e.a) 0) 1)
=+ mn=(lsh 0 ?:((syn:si e.a) (abs:si e.a) 0) 1)
=+ r=(lsh [0 ?:((syn:si e.a) (abs:si e.a) 0)] a.a)
=+ s=(lsh [0 ?.((syn:si e.a) (abs:si e.a) 0)] 1)
=+ mn=(lsh [0 ?:((syn:si e.a) (abs:si e.a) 0)] 1)
=+ mp=mn
=> ?.
?& =(a.a (bex (dec prc))) :: if next smallest
@ -2448,9 +2466,9 @@
== :: tighten lower bound
.
%= .
mp (lsh 0 1 mp)
r (lsh 0 1 r)
s (lsh 0 1 s)
mp (lsh 0 mp)
r (lsh 0 r)
s (lsh 0 s)
==
=+ [k=--0 q=(^div (^add s 9) 10)]
|- ?: (^lth r q)
@ -2487,9 +2505,9 @@
|= [a=[e=@s a=@u]] ^- fn
?. =((cmp:si e.a --0) -1) [%f & a]
=+ x=(abs:si e.a)
=+ y=(rsh 0 x a.a)
=+ y=(rsh [0 x] a.a)
?: |(=(r %d) =(r %z)) [%f & --0 y]
=+ z=(end 0 x a.a)
=+ z=(end [0 x] a.a)
?: |(=(r %u) =(r %a)) [%f & --0 ?~(z y +(y))]
=+ i=(bex (dec x))
?: &(=(z i) =((dis y 1) 0)) [%f & --0 y]
@ -2738,9 +2756,9 @@
++ bif :: fn to @r no rounding
|= [a=fn] ^- @r
?: ?=([%i *] a)
=+ q=(lsh 0 p (fil 0 w 1))
=+ q=(lsh [0 p] (fil 0 w 1))
?: s.a q (^add q sb)
?: ?=([%n *] a) (lsh 0 (dec p) (fil 0 +(w) 1))
?: ?=([%n *] a) (lsh [0 (dec p)] (fil 0 +(w) 1))
?~ a.a ?: s.a `@r`0 sb
=+ ma=(met 0 a.a)
?. =(ma +(p))
@ -2748,7 +2766,7 @@
?> (^lth ma +(p))
?: s.a `@r`a.a (^add a.a sb)
=+ q=(sum:si (dif:si e.a me) --1)
=+ r=(^add (lsh 0 p (abs:si q)) (end 0 p a.a))
=+ r=(^add (lsh [0 p] (abs:si q)) (end [0 p] a.a))
?: s.a r (^add r sb)
::
++ sig :: get sign
@ -3161,14 +3179,14 @@
++ yell :: tarp from @d
|= now=@d
^- tarp
=+ sec=(rsh 6 1 now)
=+ sec=(rsh 6 now)
=+ ^= fan
=+ [muc=4 raw=(end 6 1 now)]
=+ [muc=4 raw=(end 6 now)]
|- ^- (list @ux)
?: |(=(0 raw) =(0 muc))
~
=> .(muc (dec muc))
[(cut 4 [muc 1] raw) $(raw (end 4 muc raw))]
[(cut 4 [muc 1] raw) $(raw (end [4 muc] raw))]
=+ day=(div sec day:yo)
=> .(sec (mod sec day:yo))
=+ hor=(div sec hor:yo)
@ -3191,8 +3209,8 @@
?~ f.rip
0
=> .(muc (dec muc))
(add (lsh 4 muc i.f.rip) $(f.rip t.f.rip))
(con (lsh 6 1 sec) fac)
(add (lsh [4 muc] i.f.rip) $(f.rip t.f.rip))
(con (lsh 6 sec) fac)
::
++ yall :: day / to day of year
|= day=@ud
@ -3209,7 +3227,7 @@
=+ dis=?:(lep 366 365)
?. (lth day dis)
=+ ner=+(yer)
$(yer ner, day (sub day dis), lep =(0 (end 0 2 ner)))
$(yer ner, day (sub day dis), lep =(0 (end [0 2] ner)))
|- ^- [y=@ud m=@ud d=@ud]
=+ [mot=0 cah=?:(lep moy:yo moh:yo)]
|- ^- [y=@ud m=@ud d=@ud]
@ -3267,7 +3285,7 @@
++ shaf :: half sha-256
|= [sal=@ ruz=@]
=+ haz=(shas sal ruz)
(mix (end 7 1 haz) (rsh 7 1 haz))
(mix (end 7 haz) (rsh 7 haz))
::
++ sham :: 128bit noun hash
|= yux=* ^- @uvH ^- @
@ -3291,7 +3309,7 @@
=> .(ruz (cut 3 [0 len] ruz))
=+ [few==>(fe .(a 5)) wac=|=([a=@ b=@] (cut 5 [a 1] b))]
=+ [sum=sum.few ror=ror.few net=net.few inv=inv.few]
=+ ral=(lsh 0 3 len)
=+ ral=(lsh [0 3] len)
=+ ^= ful
%+ can 0
:~ [ral ruz]
@ -3321,10 +3339,10 @@
=+ i=0
|- ^- @
?: =(i lex)
(rep 5 (turn (rip 5 hax) net))
(run 5 hax net)
=+ ^= wox
=+ dux=(cut 9 [i 1] ful)
=+ wox=(rep 5 (turn (rip 5 dux) net))
=+ wox=(run 5 dux net)
=+ j=16
|- ^- @
?: =(64 j)
@ -3334,10 +3352,10 @@
n=(wac (sub j 16) wox)
o=(wac (sub j 7) wox)
==
=+ x=:(mix (ror 0 7 l) (ror 0 18 l) (rsh 0 3 l))
=+ y=:(mix (ror 0 17 m) (ror 0 19 m) (rsh 0 10 m))
=+ x=:(mix (ror 0 7 l) (ror 0 18 l) (rsh [0 3] l))
=+ y=:(mix (ror 0 17 m) (ror 0 19 m) (rsh [0 10] m))
=+ z=:(sum n x o y)
$(wox (con (lsh 5 j z) wox), j +(j))
$(wox (con (lsh [5 j] z) wox), j +(j))
=+ j=0
=+ :* a=(wac 0 hax)
b=(wac 1 hax)
@ -3385,7 +3403,7 @@
=> .(ruz (cut 3 [0 len] ruz))
=+ [few==>(fe .(a 6)) wac=|=([a=@ b=@] (cut 6 [a 1] b))]
=+ [sum=sum.few ror=ror.few net=net.few inv=inv.few]
=+ ral=(lsh 0 3 len)
=+ ral=(lsh [0 3] len)
=+ ^= ful
%+ can 0
:~ [ral ruz]
@ -3441,10 +3459,10 @@
=+ i=0
|- ^- @
?: =(i lex)
(rep 6 (turn (rip 6 hax) net))
(run 6 hax net)
=+ ^= wox
=+ dux=(cut 10 [i 1] ful)
=+ wox=(rep 6 (turn (rip 6 dux) net))
=+ wox=(run 6 dux net)
=+ j=16
|- ^- @
?: =(80 j)
@ -3454,10 +3472,10 @@
n=(wac (sub j 16) wox)
o=(wac (sub j 7) wox)
==
=+ x=:(mix (ror 0 1 l) (ror 0 8 l) (rsh 0 7 l))
=+ y=:(mix (ror 0 19 m) (ror 0 61 m) (rsh 0 6 m))
=+ x=:(mix (ror 0 1 l) (ror 0 8 l) (rsh [0 7] l))
=+ y=:(mix (ror 0 19 m) (ror 0 61 m) (rsh [0 6] m))
=+ z=:(sum n x o y)
$(wox (con (lsh 6 j z) wox), j +(j))
$(wox (con (lsh [6 j] z) wox), j +(j))
=+ j=0
=+ :* a=(wac 0 hax)
b=(wac 1 hax)
@ -3495,7 +3513,7 @@
|= ruz=@
=+ [few==>(fe .(a 5)) wac=|=([a=@ b=@] (cut 5 [a 1] b))]
=+ [sum=sum.few ror=ror.few rol=rol.few net=net.few inv=inv.few]
=+ ral=(lsh 0 3 (met 3 ruz))
=+ ral=(lsh [0 3] (met 3 ruz))
=+ ^= ful
%+ can 0
:~ [ral ruz]
@ -3523,7 +3541,7 @@
o=(wac (sub j 16) wox)
==
=+ z=(rol 0 1 :(mix l m n o))
$(wox (con (lsh 5 j z) wox), j +(j))
$(wox (con (lsh [5 j] z) wox), j +(j))
=+ j=0
=+ :* a=(wac 0 hax)
b=(wac 1 hax)
@ -3583,7 +3601,7 @@
~
=+ d=(shas %og-b (mix b (mix a c)))
?: (lth b 256)
[[b (end 0 b d)] ~]
[[b (end [0 b] d)] ~]
[[256 d] $(c d, b (sub b 256))]
::
++ raws :: random bits
@ -3619,7 +3637,7 @@
^- @
=+ [few==>(fe .(a 5)) wac=|=([a=@ b=@] (cut 5 [a 1] b))]
=+ [sum=sum.few ror=ror.few rol=rol.few net=net.few inv=inv.few]
=+ ral=(lsh 0 3 wid)
=+ ral=(lsh [0 3] wid)
=+ ^= ful
%+ can 0
:~ [ral (rev 3 wid dat)]
@ -3647,7 +3665,7 @@
o=(wac (sub j 16) wox)
==
=+ z=(rol 0 1 :(mix l m n o))
$(wox (con (lsh 5 j z) wox), j +(j))
$(wox (con (lsh [5 j] z) wox), j +(j))
=+ j=0
=+ :* a=(wac 0 hax)
b=(wac 1 hax)
@ -3706,7 +3724,7 @@
?: =(0 len)
~
=> .(len (dec len))
=+ mog=(zyft :(mix mig (end 3 1 len) (cut 3 [len 1] pyn)))
=+ mog=(zyft :(mix mig (end 3 len) (cut 3 [len 1] pyn)))
[[1 mog] $(mig mog)]
::
++ wred :: restore structure
@ -3724,7 +3742,7 @@
~
=> .(len (dec len))
=+ mog=(cut 3 [len 1] cry)
[[1 :(mix mig (end 3 1 len) (zyrt mog))] $(mig mog)]
[[1 :(mix mig (end 3 len) (zyrt mog))] $(mig mog)]
::
++ xafo |=([a=@ b=@] +((mod (add (dec b) a) 255)))
++ xaro |=([a=@ b=@] +((mod (add (dec b) (sub 255 (mod a 255))) 255)))
@ -4117,21 +4135,21 @@
=- yek:(roll (rip 3 key) -)
=+ [a=*char b=*@ yek=`@ux`(fil 3 256 0xff)]
|.
[+(b) (mix yek (lsh 3 `@u`a (~(inv fe 3) b)))]
[+(b) (mix yek (lsh [3 `@u`a] (~(inv fe 3) b)))]
|%
++ cha |=(a=char `(unit @uF)`=+(b=(cut 3 [`@`a 1] yek) ?:(=(b 0xff) ~ `b)))
++ tok
|= a=@ux ^- @ux
=+ b=(pad a)
=- (~(net fe 5) (end 3 4 (shay 32 -)))
(shay (add b (met 3 a)) (lsh 3 b (swp 3 a)))
=- (~(net fe 5) (end [3 4] (shay 32 -)))
(shay (add b (met 3 a)) (lsh [3 b] (swp 3 a)))
::
++ pad |=(a=@ =+(b=(met 3 a) ?:((gte b 21) 0 (sub 21 b))))
++ enc |=(a=@ux `@ux`(mix (lsh 3 4 a) (tok a)))
++ enc |=(a=@ux `@ux`(mix (lsh [3 4] a) (tok a)))
++ den
|= a=@ux ^- (unit @ux)
=+ b=(rsh 3 4 a)
?. =((tok b) (end 3 4 a))
=+ b=(rsh [3 4] a)
?. =((tok b) (end [3 4] a))
~
`b
--
@ -4145,9 +4163,9 @@
|-
?: =(0 a)
&
=+ vis=(end 3 1 a)
=+ vis=(end 3 a)
?& ?|(=('-' vis) ?&((gte vis 'a') (lte vis 'z')))
$(a (rsh 3 1 a))
$(a (rsh 3 a))
==
==
rtam
@ -4185,19 +4203,19 @@
|- ^- tape
?: (gth (met 5 a) 1)
%+ weld
$(a (rsh 5 1 a), b (sub b 4))
`tape`['-' '-' $(a (end 5 1 a), b 4)]
$(a (rsh 5 a), b (sub b 4))
`tape`['-' '-' $(a (end 5 a), b 4)]
?: =(0 b)
['~' ~]
?: (lte b 1)
(trip (tos:po a))
|- ^- tape
?: =(2 b)
=+ c=(rsh 3 1 a)
=+ d=(end 3 1 a)
=+ c=(rsh 3 a)
=+ d=(end 3 a)
(weld (trip (tod:po c)) (trip (tos:po (mix c d))))
=+ c=(rsh 3 2 a)
=+ d=(end 3 2 a)
=+ c=(rsh [3 2] a)
=+ d=(end [3 2] a)
(weld ^$(a c, b (met 3 c)) `tape`['-' $(a (mix c d), b 2)])
::
++ ruv
@ -4253,7 +4271,7 @@
++ sane :: atom sanity
|= a=@ta
|= b=@ ^- ?
?. =(%t (end 3 1 a))
?. =(%t (end 3 a))
:: XX more and better sanity
::
&
@ -4280,11 +4298,11 @@
==
|- ^- ?
?: =(0 b) &
=+ cur=(end 3 1 b)
=+ cur=(end 3 b)
?: &((lth cur 32) !=(10 cur)) |
=+ len=(teff cur)
?& |(=(1 len) =+(i=1 |-(|(=(i len) &((gte (cut 3 [i 1] b) 128) $(i +(i)))))))
$(b (rsh 3 len b))
$(b (rsh [3 len] b))
==
::
++ ruth :: biblical sanity
@ -4309,11 +4327,11 @@
|= a=@ ^- tape
?: =(0 (met 3 a))
~
[^-(@ta (end 3 1 a)) $(a (rsh 3 1 a))]
[^-(@ta (end 3 a)) $(a (rsh 3 a))]
::
++ teff :: length utf8
|= a=@t ^- @
=+ b=(end 3 1 a)
=+ b=(end 3 a)
?: =(0 b)
?>(=(`@`0 a) 0)
?> |((gte b 32) =(10 b))
@ -4337,8 +4355,8 @@
%4 [[24 6] [16 6] [8 6] [0 3] ~]
==
|=([p=@ q=@] [q (cut 0 [p q] a)])
?> =((tuft c) (end 3 b a))
[c $(a (rsh 3 b a))]
?> =((tuft c) (end [3 b] a))
[c $(a (rsh [3 b] a))]
::
++ tuba :: utf8 to utf32 tape
|= a=tape
@ -4358,25 +4376,25 @@
|- ^- (list @)
?: =(`@`0 a)
~
=+ b=(end 5 1 a)
=+ c=$(a (rsh 5 1 a))
=+ b=(end 5 a)
=+ c=$(a (rsh 5 a))
?: (lte b 0x7f)
[b c]
?: (lte b 0x7ff)
:* (mix 0b1100.0000 (cut 0 [6 5] b))
(mix 0b1000.0000 (end 0 6 b))
(mix 0b1000.0000 (end [0 6] b))
c
==
?: (lte b 0xffff)
:* (mix 0b1110.0000 (cut 0 [12 4] b))
(mix 0b1000.0000 (cut 0 [6 6] b))
(mix 0b1000.0000 (end 0 6 b))
(mix 0b1000.0000 (end [0 6] b))
c
==
:* (mix 0b1111.0000 (cut 0 [18 3] b))
(mix 0b1000.0000 (cut 0 [12 6] b))
(mix 0b1000.0000 (cut 0 [6 6] b))
(mix 0b1000.0000 (end 0 6 b))
(mix 0b1000.0000 (end [0 6] b))
c
==
::
@ -4416,13 +4434,13 @@
|- ^- (list @)
?: =(`@`0 a)
~
=+ b=(end 3 1 a)
=+ c=(rsh 3 1 a)
=+ b=(end 3 a)
=+ c=(rsh 3 a)
?: =('.' b)
[' ' $(a c)]
?. =('~' b)
[b $(a c)]
=> .(b (end 3 1 c), c (rsh 3 1 c))
=> .(b (end 3 c), c (rsh 3 c))
?+ b =- (weld (rip 3 (tuft p.d)) $(a q.d))
^= d
=+ d=0
@ -4431,8 +4449,8 @@
[d c]
?< =(0 c)
%= $
b (end 3 1 c)
c (rsh 3 1 c)
b (end 3 c)
c (rsh 3 c)
d %+ add (mul 16 d)
%+ sub b
?: &((gte b '0') (lte b '9')) 48
@ -4450,8 +4468,8 @@
?: =(`@`0 a)
~
=+ b=(teff a)
=+ c=(taft (end 3 b a))
=+ d=$(a (rsh 3 b a))
=+ c=(taft (end [3 b] a))
=+ d=$(a (rsh [3 b] a))
?: ?| &((gte c 'a') (lte c 'z'))
&((gte c '0') (lte c '9'))
=(`@`'-' c)
@ -4464,8 +4482,8 @@
?: =(0 e)
['.' d]
=. e (dec e)
=+ f=(rsh 2 e c)
[(add ?:((lte f 9) 48 87) f) $(c (end 2 e c))]
=+ f=(rsh [2 e] c)
[(add ?:((lte f 9) 48 87) f) $(c (end [2 e] c))]
::
%' ' ['.' d]
%'.' ['~' '.' d]
@ -4925,9 +4943,9 @@
|- ^- (like @t)
?: =(`@`0 daf)
[p=p.tub q=[~ u=[p=fad q=tub]]]
?: |(?=(~ q.tub) !=((end 3 1 daf) i.q.tub))
?: |(?=(~ q.tub) !=((end 3 daf) i.q.tub))
(fail tub)
$(p.tub (lust i.q.tub p.tub), q.tub t.q.tub, daf (rsh 3 1 daf))
$(p.tub (lust i.q.tub p.tub), q.tub t.q.tub, daf (rsh 3 daf))
::
++ just :: XX redundant, jest
~/ %just :: match a char
@ -5418,9 +5436,9 @@
--
++ mu
|_ [top=@ bot=@]
++ zag [p=(end 4 1 (add top bot)) q=bot]
++ zig [p=(end 4 1 (add top (sub 0x1.0000 bot))) q=bot]
++ zug (mix (lsh 4 1 top) bot)
++ zag [p=(end 4 (add top bot)) q=bot]
++ zig [p=(end 4 (add top (sub 0x1.0000 bot))) q=bot]
++ zug (mix (lsh 4 top) bot)
--
++ ne
|_ tig=@
@ -5448,7 +5466,7 @@
?~ p.lot
['_' '_' rep]
['_' (weld (trip (wack rent(lot i.p.lot))) $(p.lot t.p.lot))]
=+ [yed=(end 3 1 p.p.lot) hay=(cut 3 [1 1] p.p.lot)]
=+ [yed=(end 3 p.p.lot) hay=(cut 3 [1 1] p.p.lot)]
|- ^- tape
?+ yed (z-co q.p.lot)
%c ['~' '-' (weld (rip 3 (wood (tuft q.p.lot))) rep)]
@ -5508,8 +5526,8 @@
imp +(imp)
rep =/ log (cut 4 [imp 1] sxz)
;: weld
(trip (tos:po (rsh 3 1 log)))
(trip (tod:po (end 3 1 log)))
(trip (tos:po (rsh 3 log)))
(trip (tod:po (end 3 log)))
?:(=((mod imp 4) 0) ?:(=(imp 0) "" "--") "-")
rep
== ==
@ -5838,8 +5856,8 @@
~+
=+ ^= neg
|= [syn=? mol=dime] ^- dime
?> =('u' (end 3 1 p.mol))
[(cat 3 's' (rsh 3 1 p.mol)) (new:si syn q.mol)]
?> =('u' (end 3 p.mol))
[(cat 3 's' (rsh 3 p.mol)) (new:si syn q.mol)]
;~ pfix hep
;~ pose
(cook |=(a=dime (neg | a)) bisk)
@ -7273,9 +7291,9 @@
=+ len=(met 3 mot)
?: =(0 len)
[0 %$]
=+ tyl=(rsh 3 (dec len) mot)
=+ tyl=(rsh [3 (dec len)] mot)
?: &((gte tyl 'A') (lte tyl 'Z'))
[(sub tyl 64) (end 3 (dec len) mot)]
[(sub tyl 64) (end [3 (dec len)] mot)]
[0 mot]
=+ [yoz=(fiz yaz) wux=(fiz wix)]
?& ?| =(0 p.yoz)
@ -7284,8 +7302,8 @@
==
|- ?| =(%$ p.yoz)
=(%$ p.wux)
?& =((end 3 1 p.yoz) (end 3 1 p.wux))
$(p.yoz (rsh 3 1 p.yoz), p.wux (rsh 3 1 p.wux))
?& =((end 3 p.yoz) (end 3 p.wux))
$(p.yoz (rsh 3 p.yoz), p.wux (rsh 3 p.wux))
==
==
==
@ -7352,11 +7370,11 @@
=/ small=@ (met 0 contained)
?: (lte small big) |
=/ dif=@ (sub small big)
=(container (rsh 0 dif contained))
=(container (rsh [0 dif] contained))
::
++ parent
|= a=axis
`axis`(rsh 0 1 a)
`axis`(rsh 0 a)
::
++ sibling
|= a=axis
@ -11026,7 +11044,7 @@
['\\' i.mil $(mil t.mil)]
?: (lte ' ' i.mil)
[i.mil $(mil t.mil)]
['\\' ~(x ne (rsh 2 1 i.mil)) ~(x ne (end 2 1 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

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

@ -105,7 +105,9 @@
rot=`?`%.n :: routing attempts
==
=>
~% %ames ..is ~
|%
+| %helpers
:: +trace: print if .verb is set and we're tracking .ship
::
++ trace
@ -117,22 +119,370 @@
~+ |(=(~ ships) (~(has in ships) ship))
same
(slog leaf/"ames: {(scow %p ship)}: {(print)}" ~)
--
=>
~% %ames-generics ..is ~
|%
:: +qos-update-text: notice text for if connection state changes
::
++ qos-update-text
|= [=ship old=qos new=qos]
^- (unit tape)
::
?+ [-.old -.new] ~
[%unborn %live] `"; {(scow %p ship)} is your neighbor"
[%dead %live] `"; {(scow %p ship)} is ok"
[%live %dead] `"; {(scow %p ship)} not responding still trying"
[%unborn %dead] `"; {(scow %p ship)} not responding still trying"
[%live %unborn] `"; {(scow %p ship)} has sunk"
[%dead %unborn] `"; {(scow %p ship)} has sunk"
==
:: +lte-packets: yes if a is before b
::
++ lte-packets
|= [a=live-packet-key b=live-packet-key]
^- ?
::
?: (lth message-num.a message-num.b)
%.y
?: (gth message-num.a message-num.b)
%.n
(lte fragment-num.a fragment-num.b)
:: +split-message: split message into kilobyte-sized fragments
::
:: We don't literally split it here since that would allocate many
:: large atoms with no structural sharing. Instead, each
:: static-fragment has the entire message and a counter. In
:: +encrypt, we interpret this to get the actual fragment.
::
++ split-message
~/ %split-message
|= [=message-num =message-blob]
^- (list static-fragment)
::
=/ num-fragments=fragment-num (met 13 message-blob)
=| counter=@
::
|- ^- (list static-fragment)
?: (gte counter num-fragments)
~
::
:- [message-num num-fragments counter `@`message-blob]
$(counter +(counter))
:: +assemble-fragments: concatenate fragments into a $message
::
++ assemble-fragments
~/ %assemble-fragments
|= [num-fragments=fragment-num fragments=(map fragment-num fragment)]
^- *
::
=| sorted=(list fragment)
=. sorted
=/ index=fragment-num 0
|- ^+ sorted
?: =(index num-fragments)
sorted
$(index +(index), sorted [(~(got by fragments) index) sorted])
::
(cue (rep 13 (flop sorted)))
:: +bind-duct: find or make new $bone for .duct in .ossuary
::
++ bind-duct
|= [=ossuary =duct]
^+ [next-bone.ossuary ossuary]
::
?^ existing=(~(get by by-duct.ossuary) duct)
[u.existing ossuary]
::
:- next-bone.ossuary
:+ (add 4 next-bone.ossuary)
(~(put by by-duct.ossuary) duct next-bone.ossuary)
(~(put by by-bone.ossuary) next-bone.ossuary duct)
:: +make-bone-wire: encode ship and bone in wire for sending to vane
::
++ make-bone-wire
|= [her=ship =bone]
^- wire
::
/bone/(scot %p her)/(scot %ud bone)
:: +parse-bone-wire: decode ship and bone from wire from local vane
::
++ parse-bone-wire
|= =wire
^- [her=ship =bone]
::
~| %ames-wire-bone^wire
?> ?=([%bone @ @ ~] wire)
[`@p`(slav %p i.t.wire) `@ud`(slav %ud i.t.t.wire)]
:: +make-pump-timer-wire: construct wire for |packet-pump timer
::
++ make-pump-timer-wire
|= [her=ship =bone]
^- wire
/pump/(scot %p her)/(scot %ud bone)
:: +parse-pump-timer-wire: parse .her and .bone from |packet-pump wire
::
++ parse-pump-timer-wire
|= =wire
^- (unit [her=ship =bone])
::
~| %ames-wire-timer^wire
?. ?=([%pump @ @ ~] wire)
~
?~ ship=`(unit @p)`(slaw %p i.t.wire)
~
?~ bone=`(unit @ud)`(slaw %ud i.t.t.wire)
~
`[u.ship u.bone]
:: +derive-symmetric-key: $symmetric-key from $private-key and $public-key
::
:: Assumes keys have a tag on them like the result of the |ex:crub core.
::
++ derive-symmetric-key
~/ %derive-symmetric-key
|= [=public-key =private-key]
^- symmetric-key
::
?> =('b' (end 3 public-key))
=. public-key (rsh 8 (rsh 3 public-key))
::
?> =('B' (end 3 private-key))
=. private-key (rsh 8 (rsh 3 private-key))
::
`@`(shar:ed:crypto public-key private-key)
:: +encode-packet: serialize a packet into a bytestream
::
++ encode-packet
~/ %encode-packet
|= packet
^- blob
::
=/ sndr-meta (encode-ship-metadata sndr)
=/ rcvr-meta (encode-ship-metadata rcvr)
::
=/ body=@
;: mix
sndr-tick
(lsh 2 rcvr-tick)
(lsh 3 sndr)
(lsh [3 +(size.sndr-meta)] rcvr)
(lsh [3 +((add size.sndr-meta size.rcvr-meta))] content)
==
=/ checksum (end [0 20] (mug body))
=? body ?=(^ origin) (mix u.origin (lsh [3 6] body))
::
=/ header=@
%+ can 0
:~ [3 reserved=0]
[1 is-ames=&]
[3 protocol-version]
[2 rank.sndr-meta]
[2 rank.rcvr-meta]
[20 checksum]
[1 relayed=.?(origin)]
==
(mix header (lsh 5 body))
:: +decode-packet: deserialize packet from bytestream or crash
::
++ decode-packet
~/ %decode-packet
|= =blob
^- packet
~| %decode-packet-fail
:: first 32 (2^5) bits are header; the rest is body
::
=/ header (end 5 blob)
=/ body (rsh 5 blob)
:: read header; first three bits are reserved
::
=/ is-ames (cut 0 [3 1] header)
?. =(& is-ames)
~| %ames-not-ames !!
::
=/ version (cut 0 [4 3] header)
?. =(protocol-version version)
~| ames-protocol-version+version !!
::
=/ sndr-size (decode-ship-size (cut 0 [7 2] header))
=/ rcvr-size (decode-ship-size (cut 0 [9 2] header))
=/ checksum (cut 0 [11 20] header)
=/ relayed (cut 0 [31 1] header)
:: origin, if present, is 6 octets long, at the end of the body
::
=^ origin=(unit @) body
?: =(| relayed)
[~ body]
=/ len (sub (met 3 body) 6)
[`(end [3 6] body) (rsh [3 6] body)]
:: .checksum does not apply to the origin
::
?. =(checksum (end [0 20] (mug body)))
~| %ames-checksum !!
:: read fixed-length sndr and rcvr life data from body
::
:: These represent the last four bits of the sender and receiver
:: life fields, to be used for quick dropping of honest packets to
:: or from the wrong life.
::
=/ sndr-tick (cut 0 [0 4] body)
=/ rcvr-tick (cut 0 [4 4] body)
:: read variable-length .sndr and .rcvr addresses
::
=/ off 1
=^ sndr off [(cut 3 [off sndr-size] body) (add off sndr-size)]
?. (is-valid-rank sndr sndr-size)
~| ames-sender-impostor+[sndr sndr-size] !!
::
=^ rcvr off [(cut 3 [off rcvr-size] body) (add off rcvr-size)]
?. (is-valid-rank rcvr rcvr-size)
~| ames-receiver-impostor+[rcvr rcvr-size] !!
:: read variable-length .content from the rest of .body
::
=/ content (cut 3 [off (sub (met 3 body) off)] body)
[[sndr rcvr] sndr-tick rcvr-tick origin content]
:: +is-valid-rank: does .ship match its stated .size?
::
++ is-valid-rank
~/ %is-valid-rank
|= [=ship size=@ubC]
^- ?
.= size
?- (clan:title ship)
%czar 2
%king 2
%duke 4
%earl 8
%pawn 16
==
:: +encode-open-packet: convert $open-packet attestation to $packet
::
++ encode-open-packet
~/ %encode-open-packet
|= [pac=open-packet =acru:ames]
^- packet
:* [sndr rcvr]:pac
(mod sndr-life.pac 16)
(mod rcvr-life.pac 16)
origin=~
content=`@`(sign:as:acru (jam pac))
==
:: +decode-open-packet: decode comet attestation into an $open-packet
::
++ decode-open-packet
~/ %decode-open-packet
|= [=packet our=ship our-life=@]
^- open-packet
:: deserialize and type-check packet contents
::
=+ ;; [signature=@ signed=@] (cue content.packet)
=+ ;; =open-packet (cue signed)
:: assert .our and .her and lives match
::
?> .= sndr.open-packet sndr.packet
?> .= rcvr.open-packet our
?> .= sndr-life.open-packet 1
?> .= rcvr-life.open-packet our-life
:: only a star can sponsor a comet
::
?> =(%king (clan:title (^sein:title sndr.packet)))
:: comet public-key must hash to its @p address
::
?> =(sndr.packet fig:ex:(com:nu:crub:crypto public-key.open-packet))
:: verify signature
::
:: Logic duplicates +com:nu:crub:crypto and +sure:as:crub:crypto.
::
=/ key (end 8 (rsh 3 public-key.open-packet))
?> (veri:ed:crypto signature signed key)
open-packet
:: +encode-shut-packet: encrypt and packetize a $shut-packet
::
++ encode-shut-packet
~/ %encode-shut-packet
|= $: =shut-packet
=symmetric-key
sndr=ship
rcvr=ship
sndr-life=@
rcvr-life=@
==
^- packet
::
=? meat.shut-packet
?& ?=(%& -.meat.shut-packet)
(gth (met 13 fragment.p.meat.shut-packet) 1)
==
%_ meat.shut-packet
fragment.p
(cut 13 [[fragment-num 1] fragment]:p.meat.shut-packet)
==
::
=/ vec ~[sndr rcvr sndr-life rcvr-life]
=/ [siv=@uxH len=@ cyf=@ux]
(~(en sivc:aes:crypto (shaz symmetric-key) vec) (jam shut-packet))
=/ content :(mix siv (lsh 7 len) (lsh [3 18] cyf))
[[sndr rcvr] (mod sndr-life 16) (mod rcvr-life 16) origin=~ content]
:: +decode-shut-packet: decrypt a $shut-packet from a $packet
::
++ decode-shut-packet
~/ %decode-shut-packet
|= [=packet =symmetric-key sndr-life=@ rcvr-life=@]
^- shut-packet
?. =(sndr-tick.packet (mod sndr-life 16))
~| ames-sndr-tick+sndr-tick.packet !!
?. =(rcvr-tick.packet (mod rcvr-life 16))
~| ames-rcvr-tick+rcvr-tick.packet !!
=/ siv (end 7 content.packet)
=/ len (end 4 (rsh 7 content.packet))
=/ cyf (rsh [3 18] content.packet)
~| ames-decrypt+[[sndr rcvr origin]:packet len siv]
=/ vec ~[sndr.packet rcvr.packet sndr-life rcvr-life]
;; shut-packet %- cue %- need
(~(de sivc:aes:crypto (shaz symmetric-key) vec) siv len cyf)
:: +decode-ship-size: decode a 2-bit ship type specifier into a byte width
::
:: Type 0: galaxy or star -- 2 bytes
:: Type 1: planet -- 4 bytes
:: Type 2: moon -- 8 bytes
:: Type 3: comet -- 16 bytes
::
++ decode-ship-size
~/ %decode-ship-size
|= rank=@ubC
^- @
::
?+ rank !!
%0b0 2
%0b1 4
%0b10 8
%0b11 16
==
:: +encode-ship-metadata: produce size (in bytes) and address rank for .ship
::
:: 0: galaxy or star
:: 1: planet
:: 2: moon
:: 3: comet
::
++ encode-ship-metadata
~/ %encode-ship-metadata
|= =ship
^- [size=@ =rank]
::
=/ size=@ (met 3 ship)
::
?: (lte size 2) [2 %0b0]
?: (lte size 4) [4 %0b1]
?: (lte size 8) [8 %0b10]
[16 %0b11]
+| %atomics
::
+$ private-key @uwprivatekey
+$ signature @uwsignature
:: $rank: which kind of ship address, by length
::
:: 0: galaxy or star -- 2 bytes
:: 1: planet -- 4 bytes
:: 2: moon -- 8 bytes
:: 3: comet -- 16 bytes
:: 0b0: galaxy or star -- 2 bytes
:: 0b1: planet -- 4 bytes
:: 0b10: moon -- 8 bytes
:: 0b11: comet -- 16 bytes
::
+$ rank ?(%0 %1 %2 %3)
+$ rank ?(%0b0 %0b1 %0b10 %0b11)
::
+| %kinetics
:: $channel: combined sender and receiver identifying data
@ -165,7 +515,13 @@
:: address. Routes are opaque to Arvo and only have meaning in the
:: interpreter. This enforces that Ames is transport-agnostic.
::
+$ packet [dyad encrypted=? origin=(unit lane) content=*]
+$ packet
$: dyad
sndr-tick=@ubC
rcvr-tick=@ubC
origin=(unit @uxaddress)
content=@uxcontent
==
:: $open-packet: unencrypted packet payload, for comet self-attestation
::
:: This data structure gets signed and jammed to form the .contents
@ -181,9 +537,7 @@
:: $shut-packet: encrypted packet payload
::
+$ shut-packet
$: =sndr=life
=rcvr=life
=bone
$: =bone
=message-num
meat=(each fragment-meat ack-meat)
==
@ -691,14 +1045,16 @@
``noun+!>(!>(res))
==
--
:: helpers
:: |per-event: inner event-handling core
::
~% %ames-helpers +>+ ~
~% %per-event ..decode-packet ~
|%
++ per-event
=| moves=(list move)
~% %event-gate ..per-event ~
|= [[our=ship now=@da eny=@ scry-gate=sley] =duct =ames-state]
=* veb veb.bug.ames-state
~% %event-core ..$ ~
|%
++ event-core .
++ abet [(flop moves) ames-state]
@ -848,20 +1204,14 @@
=/ =channel [[our ship] now channel-state -.peer-state]
abet:on-jilt:(make-peer-core peer-state channel)
:: +on-hear: handle raw packet receipt
::
++ on-hear
|= [=lane =blob]
^+ event-core
(on-hear-packet lane (decode-packet blob) ok=%.y)
:: +on-hole: handle packet crash notification
::
++ on-hole
|= [=lane =blob]
^+ event-core
(on-hear-packet lane (decode-packet blob) ok=%.n)
++ on-hear |=([l=lane b=blob] (on-hear-packet l (decode-packet b) ok=&))
++ on-hole |=([l=lane b=blob] (on-hear-packet l (decode-packet b) ok=|))
:: +on-hear-packet: handle mildly processed packet receipt
::
++ on-hear-packet
~/ %on-hear-packet
|= [=lane =packet ok=?]
^+ event-core
::
@ -873,9 +1223,11 @@
?. =(our rcvr.packet)
on-hear-forward
::
?: encrypted.packet
on-hear-shut
on-hear-open
?: ?& ?=(%pawn (clan:title sndr.packet))
!(~(has by peers.ames-state) sndr.packet)
==
on-hear-open
on-hear-shut
:: +on-hear-forward: maybe forward a packet to someone else
::
:: Note that this performs all forwarding requests without
@ -883,18 +1235,27 @@
:: provided by Vere.
::
++ on-hear-forward
~/ %on-hear-forward
|= [=lane =packet ok=?]
^+ event-core
%- %^ trace for.veb sndr.packet
|.("forward: {<sndr.packet>} -> {<rcvr.packet>}")
:: set .origin.packet if it doesn't already have one, re-encode, and send
::
=? origin.packet ?=(~ origin.packet) `lane
=? origin.packet
&(?=(~ origin.packet) !=(%czar (clan:title sndr.packet)))
?: ?=(%& -.lane)
~
?. (lte (met 3 p.lane) 6)
~| ames-lane-size+p.lane !!
`p.lane
::
=/ =blob (encode-packet packet)
(send-blob & rcvr.packet blob)
:: +on-hear-open: handle receipt of plaintext comet self-attestation
::
++ on-hear-open
~/ %on-hear-open
|= [=lane =packet ok=?]
^+ event-core
:: assert the comet can't pretend to be a moon or other address
@ -905,29 +1266,8 @@
=/ ship-state (~(get by peers.ames-state) sndr.packet)
?: ?=([~ %known *] ship-state)
event-core
:: deserialize and type-check packet contents
::
?> ?=(@ content.packet)
=+ ;; [signature=@ signed=@] (cue content.packet)
=+ ;; =open-packet (cue signed)
:: assert .our and .her and lives match
::
?> .= sndr.open-packet sndr.packet
?> .= rcvr.open-packet our
?> .= sndr-life.open-packet 1
?> .= rcvr-life.open-packet life.ames-state
:: only a star can sponsor a comet
::
?> =(%king (clan:title (^sein:title sndr.packet)))
:: comet public-key must hash to its @p address
::
?> =(sndr.packet fig:ex:(com:nu:crub:crypto public-key.open-packet))
:: verify signature
::
:: Logic duplicates +com:nu:crub:crypto and +sure:as:crub:crypto.
::
=/ key (end 8 1 (rsh 3 1 public-key.open-packet))
?> (veri:ed:crypto signature signed key)
=/ =open-packet (decode-open-packet packet our life.ames-state)
:: store comet as peer in our state
::
=. peers.ames-state
@ -952,12 +1292,9 @@
:: +on-hear-shut: handle receipt of encrypted packet
::
++ on-hear-shut
~/ %on-hear-shut
|= [=lane =packet ok=?]
^+ event-core
:: encrypted packet content must be an encrypted atom
::
?> ?=(@ content.packet)
::
=/ sndr-state (~(get by peers.ames-state) sndr.packet)
:: if we don't know them, maybe enqueue a jael %public-keys request
::
@ -977,19 +1314,11 @@
=/ =peer-state +.u.sndr-state
=/ =channel [[our sndr.packet] now channel-state -.peer-state]
~| %ames-crash-on-packet-from^her.channel
=/ =shut-packet (decrypt symmetric-key.channel content.packet)
:: ward against replay attacks
::
:: We only accept packets from a ship at their known life, and to
:: us at our current life.
::
~| our-life=[expected=our-life.channel got=rcvr-life.shut-packet]
~| her-life=[expected=her-life.channel got=sndr-life.shut-packet]
?> =(sndr-life.shut-packet her-life.channel)
?> =(rcvr-life.shut-packet our-life.channel)
=/ =shut-packet
(decode-shut-packet packet [symmetric-key her-life our-life]:channel)
:: non-galaxy: update route with heard lane or forwarded lane
::
=? route.peer-state !=(%czar (clan:title her.channel))
=? route.peer-state !=(%czar (clan:title her.channel))
:: if new packet is direct, use that. otherwise, if the new new
:: and old lanes are indirect, use the new one. if the new lane
:: is indirect but the old lane is direct, then if the lanes are
@ -1012,10 +1341,10 @@
?: ?=(~ origin.packet)
`[direct=%.y lane]
?: ?=([~ %& *] route.peer-state)
?: =(lane.u.route.peer-state u.origin.packet)
?: =(lane.u.route.peer-state |+u.origin.packet)
route.peer-state
`[direct=%.n u.origin.packet]
`[direct=%.n u.origin.packet]
`[direct=%.n |+u.origin.packet]
`[direct=%.n |+u.origin.packet]
:: perform peer-specific handling of packet
::
=/ peer-core (make-peer-core peer-state channel)
@ -1397,6 +1726,7 @@
:: request the information from Jael if we haven't already.
::
++ send-blob
~/ %send-blob
|= [for=? =ship =blob]
::
=/ final-ship ship
@ -1461,19 +1791,15 @@
++ attestation-packet
|= [her=ship =her=life]
^- blob
::
=/ =open-packet
:* ^= public-key pub:ex:crypto-core.ames-state
^= sndr our
^= sndr-life life.ames-state
^= rcvr her
^= rcvr-life her-life
==
::
=/ signed=@ (sign:as:crypto-core.ames-state (jam open-packet))
=/ =packet [[our her] encrypted=%.n origin=~ signed]
::
(encode-packet packet)
%- encode-packet
%- encode-open-packet
:_ crypto-core.ames-state
:* ^= public-key pub:ex:crypto-core.ames-state
^= sndr our
^= sndr-life life.ames-state
^= rcvr her
^= rcvr-life her-life
==
:: +get-peer-state: lookup .her state or ~
::
++ get-peer-state
@ -1551,7 +1877,7 @@
=/ pumps=(list message-pump-state)
%+ murn ~(tap by snd.peer-state)
|= [=bone =message-pump-state]
?: =(0 (end 0 1 bone))
?: =(0 (end 0 bone))
~
`u=message-pump-state
:: clogged: are five or more response messages unsent to this peer?
@ -1732,13 +2058,15 @@
:: kind of flow this is (forward/backward), so flip the bit
:: here.
::
=. bone.shut-packet (mix 1 bone.shut-packet)
::
=/ content (encrypt symmetric-key.channel shut-packet)
=/ =packet [[our her.channel] encrypted=%.y origin=~ content]
=/ =blob (encode-packet packet)
::
=. event-core (send-blob | her.channel blob)
=. event-core
%^ send-blob | her.channel
%- encode-packet
%: encode-shut-packet
shut-packet(bone (mix 1 bone.shut-packet))
symmetric-key.channel
our her.channel
our-life.channel her-life.channel
==
peer-core
:: +got-duct: look up $duct by .bone, asserting already bound
::
@ -1780,11 +2108,11 @@
^+ peer-core
:: if odd bone, ack is on "subscription update" message; no-op
::
?: =(1 (end 0 1 bone))
?: =(1 (end 0 bone))
peer-core
:: even bone; is this bone a nack-trace bone?
::
?: =(1 (end 0 1 (rsh 0 1 bone)))
?: =(1 (end 0 (rsh 0 bone)))
:: nack-trace bone; assume .ok, clear nack from |message-sink
::
=/ target-bone=^bone (mix 0b10 bone)
@ -1796,17 +2124,7 @@
:: +on-pump-send: emit message fragment requested by |message-pump
::
++ on-pump-send
|= =static-fragment
^+ peer-core
:: encrypt and encode .static-fragment to .blob bitstream
::
%- send-shut-packet :*
our-life.channel
her-life.channel
bone
message-num.static-fragment
%& +.static-fragment
==
|=(f=static-fragment (send-shut-packet bone [message-num %& +]:f))
:: +on-pump-wait: relay |message-pump's set-timer request
::
++ on-pump-wait
@ -1853,16 +2171,7 @@
:: +on-sink-send: emit ack packet as requested by |message-sink
::
++ on-sink-send
|= [=message-num =ack-meat]
^+ peer-core
::
%- send-shut-packet :*
our-life.channel
her-life.channel
bone
message-num
%| ack-meat
==
|=([num=message-num ack=ack-meat] (send-shut-packet bone num %| ack))
:: +on-sink-memo: dispatch message received by |message-sink
::
:: odd bone: %plea request message
@ -1870,9 +2179,9 @@
:: even bone, 1 second bit: nack-trace %boon message
::
++ on-sink-memo
?: =(1 (end 0 1 bone))
?: =(1 (end 0 bone))
on-sink-plea
?: =(0 (end 0 1 (rsh 0 1 bone)))
?: =(0 (end 0 (rsh 0 bone)))
on-sink-boon
on-sink-nack-trace
:: +on-sink-boon: handle response message received by |message-sink
@ -2783,259 +3092,4 @@
::
message-sink
--
:: +qos-update-text: notice text for if connection state changes
::
++ qos-update-text
|= [=ship old=qos new=qos]
^- (unit tape)
::
?+ [-.old -.new] ~
[%unborn %live] `"; {(scow %p ship)} is your neighbor"
[%dead %live] `"; {(scow %p ship)} is ok"
[%live %dead] `"; {(scow %p ship)} not responding still trying"
[%unborn %dead] `"; {(scow %p ship)} not responding still trying"
[%live %unborn] `"; {(scow %p ship)} has sunk"
[%dead %unborn] `"; {(scow %p ship)} has sunk"
==
:: +lte-packets: yes if a is before b
::
++ lte-packets
|= [a=live-packet-key b=live-packet-key]
^- ?
::
?: (lth message-num.a message-num.b)
%.y
?: (gth message-num.a message-num.b)
%.n
(lte fragment-num.a fragment-num.b)
:: +split-message: split message into kilobyte-sized fragments
::
:: We don't literally split it here since that would allocate many
:: large atoms with no structural sharing. Instead, each
:: static-fragment has the entire message and a counter. In
:: +encrypt, we interpret this to get the actual fragment.
::
++ split-message
|= [=message-num =message-blob]
^- (list static-fragment)
::
=/ num-fragments=fragment-num (met 13 message-blob)
=| counter=@
::
|- ^- (list static-fragment)
?: (gte counter num-fragments)
~
::
:- [message-num num-fragments counter `@`message-blob]
$(counter +(counter))
:: +assemble-fragments: concatenate fragments into a $message
::
++ assemble-fragments
|= [num-fragments=fragment-num fragments=(map fragment-num fragment)]
^- *
::
=| sorted=(list fragment)
=. sorted
=/ index=fragment-num 0
|- ^+ sorted
?: =(index num-fragments)
sorted
$(index +(index), sorted [(~(got by fragments) index) sorted])
::
%- cue
%+ can 13
%+ turn (flop sorted)
|=(a=@ [1 a])
:: +bind-duct: find or make new $bone for .duct in .ossuary
::
++ bind-duct
|= [=ossuary =duct]
^+ [next-bone.ossuary ossuary]
::
?^ existing=(~(get by by-duct.ossuary) duct)
[u.existing ossuary]
::
:- next-bone.ossuary
:+ (add 4 next-bone.ossuary)
(~(put by by-duct.ossuary) duct next-bone.ossuary)
(~(put by by-bone.ossuary) next-bone.ossuary duct)
:: +make-bone-wire: encode ship and bone in wire for sending to vane
::
++ make-bone-wire
|= [her=ship =bone]
^- wire
::
/bone/(scot %p her)/(scot %ud bone)
:: +parse-bone-wire: decode ship and bone from wire from local vane
::
++ parse-bone-wire
|= =wire
^- [her=ship =bone]
::
~| %ames-wire-bone^wire
?> ?=([%bone @ @ ~] wire)
[`@p`(slav %p i.t.wire) `@ud`(slav %ud i.t.t.wire)]
:: +make-pump-timer-wire: construct wire for |packet-pump timer
::
++ make-pump-timer-wire
|= [her=ship =bone]
^- wire
/pump/(scot %p her)/(scot %ud bone)
:: +parse-pump-timer-wire: parse .her and .bone from |packet-pump wire
::
++ parse-pump-timer-wire
|= =wire
^- (unit [her=ship =bone])
::
~| %ames-wire-timer^wire
?. ?=([%pump @ @ ~] wire)
~
?~ ship=`(unit @p)`(slaw %p i.t.wire)
~
?~ bone=`(unit @ud)`(slaw %ud i.t.t.wire)
~
`[u.ship u.bone]
:: +derive-symmetric-key: $symmetric-key from $private-key and $public-key
::
:: Assumes keys have a tag on them like the result of the |ex:crub core.
::
++ derive-symmetric-key
|= [=public-key =private-key]
^- symmetric-key
::
?> =('b' (end 3 1 public-key))
=. public-key (rsh 8 1 (rsh 3 1 public-key))
::
?> =('B' (end 3 1 private-key))
=. private-key (rsh 8 1 (rsh 3 1 private-key))
::
`@`(shar:ed:crypto public-key private-key)
:: +encrypt: encrypt $shut-packet into atomic packet content
::
++ encrypt
|= [=symmetric-key plaintext=shut-packet]
^- @
::
=? meat.plaintext
?& ?=(%& -.meat.plaintext)
(gth (met 13 fragment.p.meat.plaintext) 1)
==
%_ meat.plaintext
fragment.p
(cut 13 [[fragment-num 1] fragment]:p.meat.plaintext)
==
(en:crub:crypto symmetric-key (jam plaintext))
:: +decrypt: decrypt packet content to a $shut-packet or die
::
++ decrypt
|= [=symmetric-key ciphertext=@]
^- shut-packet
::
;; shut-packet
%- cue
%- need
(de:crub:crypto symmetric-key ciphertext)
:: +encode-packet: serialize a packet into a bytestream
::
++ encode-packet
|= packet
^- blob
::
=/ sndr-meta (encode-ship-metadata sndr)
=/ rcvr-meta (encode-ship-metadata rcvr)
:: body: <<sndr rcvr (jam [origin content])>>
::
:: The .sndr and .rcvr ship addresses are encoded with fixed
:: lengths specified by the packet header. They live outside
:: the jammed-data section to simplify packet filtering in the
:: interpreter.
::
=/ body=@
;: mix
sndr
(lsh 3 size.sndr-meta rcvr)
(lsh 3 (add size.sndr-meta size.rcvr-meta) (jam [origin content]))
==
:: header: 32-bit header assembled from bitstreams of fields
::
:: <<version checksum sndr-rank rcvr-rank encryption-type unused>>
:: 4 bits at the end of the header are unused.
::
=/ header=@
%+ can 0
:~ [3 protocol-version]
[20 (mug body)]
[2 rank.sndr-meta]
[2 rank.rcvr-meta]
[5 ?:(encrypted %0 %1)]
==
:: result is <<header body>>
::
(mix header (lsh 5 1 body))
:: +decode-packet: deserialize packet from bytestream or crash
::
++ decode-packet
|= =blob
^- packet
:: first 32 (2^5) bits are header; the rest is body
::
=/ header (end 5 1 blob)
=/ body (rsh 5 1 blob)
::
=/ version (end 0 3 header)
=/ checksum (cut 0 [3 20] header)
=/ sndr-size (decode-ship-size (cut 0 [23 2] header))
=/ rcvr-size (decode-ship-size (cut 0 [25 2] header))
=/ encrypted ?+((cut 0 [27 5] header) !! %0 %.y, %1 %.n)
::
=/ =dyad
:- sndr=(end 3 sndr-size body)
rcvr=(cut 3 [sndr-size rcvr-size] body)
::
?. =(protocol-version version)
~| %ames-protocol^version^dyad !!
?. =(checksum (end 0 20 (mug body)))
~| %ames-checksum^dyad !!
::
=+ ~| %ames-invalid-packet
;; [origin=(unit lane) content=*]
~| %ames-invalid-noun
%- cue
(rsh 3 (add rcvr-size sndr-size) body)
::
[dyad encrypted origin content]
:: +decode-ship-size: decode a 2-bit ship type specifier into a byte width
::
:: Type 0: galaxy or star -- 2 bytes
:: Type 1: planet -- 4 bytes
:: Type 2: moon -- 8 bytes
:: Type 3: comet -- 16 bytes
::
++ decode-ship-size
|= rank=@
^- @
::
?+ rank !!
%0 2
%1 4
%2 8
%3 16
==
:: +encode-ship-metadata: produce size (in bytes) and address rank for .ship
::
:: 0: galaxy or star
:: 1: planet
:: 2: moon
:: 3: comet
::
++ encode-ship-metadata
|= =ship
^- [size=@ =rank]
::
=/ size=@ (met 3 ship)
::
?: (lte size 2) [2 %0]
?: (lte size 4) [4 %1]
?: (lte size 8) [8 %2]
[16 %3]
--

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

@ -1978,7 +1978,7 @@
|= =term
=/ vane=@t (path-to-cord data /sys/vane/[term]/hoon)
%- emit
=/ tip (end 3 1 term)
=/ tip (end 3 term)
=/ =path /sys/vane/[term]/hoon
[hen %pass /reload %d %flog %veer tip path vane]
--
@ -3839,7 +3839,7 @@
=+ pac=(of-wain (lurk:differ (to-wain (cat 3 txt '\0a')) dif))
?~ pac
''
(end 3 (dec (met 3 pac)) pac)
(end [3 (dec (met 3 pac))] pac)
::
:: Gets an arch (directory listing) at a node.
::

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

@ -753,7 +753,7 @@
?- -.mym
%| (error-response 500 "failed tube from {(trip mark)} to mime")
%& %+ return-static-data-on-duct 200
[(rsh 3 1 (spat p.p.mym)) q.p.mym]
[(rsh 3 (spat p.p.mym)) q.p.mym]
==
::
++ find-tube
@ -1031,7 +1031,7 @@
=+ pax=/(scot %p our)/code/(scot %da now)/(scot %p our)
=+ res=((sloy scry) [151 %noun] %j pax)
::
(rsh 3 1 (scot %p (@ (need (need res)))))
(rsh 3 (scot %p (@ (need (need res)))))
:: +session-cookie-string: compose session cookie
::
++ session-cookie-string

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

@ -332,7 +332,7 @@
control-duct hen
beak bek
agent &+agent
nonce (scot %uw (end 5 1 (shas %yoke-nonce eny)))
nonce (scot %uw (end 5 (shas %yoke-nonce eny)))
==
::
=/ old mo-core

2
pkg/arvo/sys/vane/jael.hoon
View File

@ -1045,7 +1045,7 @@
=/ who (slaw %p i.tyl)
?~ who [~ ~]
=/ sec (~(got by jaw.own.pki.lex) lyf.own.pki.lex)
``[%noun !>((end 6 1 (shaf %pass (shax sec))))]
``[%noun !>((end 6 (shaf %pass (shax sec))))]
::
%life
?. ?=([@ ~] tyl) [~ ~]

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

@ -83,7 +83,8 @@
+$ styl %+ pair (unit deco) :: cascading style
(pair (unit tint) (unit tint)) ::
+$ styx (list $@(@t (pair styl styx))) :: styled text
+$ tint ?(%r %g %b %c %m %y %k %w %~) :: text color
+$ tint $@ ?(%r %g %b %c %m %y %k %w %~) :: text color
[r=@uxD g=@uxD b=@uxD] :: 24bit true color
+$ turf (list @t) :: domain, tld first
:: ::
:::: ++jstd :: json standards structures
@ -2316,7 +2317,7 @@
:: :: ++pram:number
++ pram :: rabin-miller
|= a=@ ^- ?
?: ?| =(0 (end 0 1 a))
?: ?| =(0 (end 0 a))
=(1 a)
=+ b=1
|- ^- ?
@ -2328,8 +2329,8 @@
=+ ^= b
=+ [s=(dec a) t=0]
|- ^- [s=@ t=@]
?: =(0 (end 0 1 s))
$(s (rsh 0 1 s), t +(t))
?: =(0 (end 0 s))
$(s (rsh 0 s), t +(t))
[s t]
?> =((mul s.b (bex t.b)) (dec a))
=+ c=0
@ -2425,7 +2426,7 @@
?: =(i 0)
=+ x=(cub r)
(sit.fq (mul -.x (inv +.x)))
=+ m=(rsh 0 i a)
=+ m=(rsh [0 i] a)
?: =(0 (mod m 2))
$(i (dec i), s (cad r s one), r (cub r))
$(i (dec i), r (cad r s one), s (cub s))
@ -2447,16 +2448,16 @@
~| [%dub-ga a]
?> (lth b si)
?: =(1 (cut 0 [(dec p.a) 1] b))
(dif (sit q.a) (sit (lsh 0 1 b)))
(lsh 0 1 b)
(dif (sit q.a) (sit (lsh 0 b)))
(lsh 0 b)
:: :: ++pro:ga:number
++ pro :: slow multiply
|= [b=@ c=@]
?: =(0 b)
0
?: =(1 (dis 1 b))
(dif c $(b (rsh 0 1 b), c (dub c)))
$(b (rsh 0 1 b), c (dub c))
(dif c $(b (rsh 0 b), c (dub c)))
$(b (rsh 0 b), c (dub c))
:: :: ++toe:ga:number
++ toe :: exp+log tables
=+ ^= nu
@ -2779,7 +2780,7 @@
|= blk=@H ^- @uxH
=+ (ahem 6 4 12)
=:
key (rsh 6 1 (~(net fe 8) key))
key (rsh 6 (~(net fe 8) key))
blk (~(net fe 7) blk)
==
%- ~(net fe 7)
@ -2790,7 +2791,7 @@
|= blk=@H ^- @uxH
=+ (ahem 6 4 12)
=:
key (rsh 6 1 (~(net fe 8) key))
key (rsh 6 (~(net fe 8) key))
blk (~(net fe 7) blk)
==
%- ~(net fe 7)
@ -2961,7 +2962,7 @@
=/ blocks (add (div len 16) ?:(=((^mod len 16) 0) 0 1))
?> (gte len (met 3 txt))
%+ mix txt
%^ rsh 3 (sub (mul 16 blocks) len)
%+ rsh [3 (sub (mul 16 blocks) len)]
%+ rep 7
=| seed=(list @ux)
|- ^+ seed
@ -2988,7 +2989,7 @@
=/ blocks (add (div len 16) ?:(=((^mod len 16) 0) 0 1))
?> (gte len (met 3 txt))
%+ mix txt
%^ rsh 3 (sub (mul 16 blocks) len)
%+ rsh [3 (sub (mul 16 blocks) len)]
%+ rep 7
=| seed=(list @ux)
|- ^+ seed
@ -3015,7 +3016,7 @@
=/ blocks (add (div len 16) ?:(=((^mod len 16) 0) 0 1))
?> (gte len (met 3 txt))
%+ mix txt
%^ rsh 3 (sub (mul 16 blocks) len)
%+ rsh [3 (sub (mul 16 blocks) len)]
%+ rep 7
=| seed=(list @ux)
|- ^+ seed
@ -3040,8 +3041,8 @@
^- @uxH
%- ~(sit fe 7)
?. =((xeb str) 128)
(lsh 0 1 str)
(mix 0x87 (lsh 0 1 str))
(lsh 0 str)
(mix 0x87 (lsh 0 str))
:: :: ++mpad:aes:crypto
++ mpad ::
|= [oct=@ txt=@]
@ -3054,7 +3055,7 @@
^- @ux
=+ pad=(mod oct 16)
?: =(pad 0) 0x8000.0000.0000.0000.0000.0000.0000.0000
(lsh 3 (sub 15 pad) (mix 0x80 (lsh 3 1 txt)))
(lsh [3 (sub 15 pad)] (mix 0x80 (lsh 3 txt)))
:: :: ++suba:aes:crypto
++ suba :: AES-128 subkeys
|= key=@H
@ -3199,7 +3200,7 @@
~/ %en
|= txt=@
^- (trel @uxH @ud @ux)
=+ [k1=(rsh 7 1 key) k2=(end 7 1 key)]
=+ [k1=(rsh 7 key) k2=(end 7 key)]
=+ iv=(s2va k1 (weld vec (limo ~[txt])))
=+ len=(met 3 txt)
=* hib (dis iv 0xffff.ffff.ffff.ffff.7fff.ffff.7fff.ffff)
@ -3212,7 +3213,7 @@
~/ %de
|= [iv=@H len=@ txt=@]
^- (unit @ux)
=+ [k1=(rsh 7 1 key) k2=(end 7 1 key)]
=+ [k1=(rsh 7 key) k2=(end 7 key)]
=* hib (dis iv 0xffff.ffff.ffff.ffff.7fff.ffff.7fff.ffff)
=+ ^= pln
(~(de ctra k2 7 len hib) txt)
@ -3229,7 +3230,7 @@
~/ %en
|= txt=@
^- (trel @uxH @ud @ux)
=+ [k1=(rsh 6 3 key) k2=(end 6 3 key)]
=+ [k1=(rsh [6 3] key) k2=(end [6 3] key)]
=+ iv=(s2vb k1 (weld vec (limo ~[txt])))
=* hib (dis iv 0xffff.ffff.ffff.ffff.7fff.ffff.7fff.ffff)
=+ len=(met 3 txt)
@ -3241,7 +3242,7 @@
~/ %de
|= [iv=@H len=@ txt=@]
^- (unit @ux)
=+ [k1=(rsh 6 3 key) k2=(end 6 3 key)]
=+ [k1=(rsh [6 3] key) k2=(end [6 3] key)]
=* hib (dis iv 0xffff.ffff.ffff.ffff.7fff.ffff.7fff.ffff)
=+ ^= pln
(~(de ctrb k2 7 len hib) txt)
@ -3258,7 +3259,7 @@
~/ %en
|= txt=@
^- (trel @uxH @ud @ux)
=+ [k1=(rsh 8 1 key) k2=(end 8 1 key)]
=+ [k1=(rsh 8 key) k2=(end 8 key)]
=+ iv=(s2vc k1 (weld vec (limo ~[txt])))
=* hib (dis iv 0xffff.ffff.ffff.ffff.7fff.ffff.7fff.ffff)
=+ len=(met 3 txt)
@ -3271,7 +3272,7 @@
~/ %de
|= [iv=@H len=@ txt=@]
^- (unit @ux)
=+ [k1=(rsh 8 1 key) k2=(end 8 1 key)]
=+ [k1=(rsh 8 key) k2=(end 8 key)]
=* hib (dis iv 0xffff.ffff.ffff.ffff.7fff.ffff.7fff.ffff)
=+ ^= pln
(~(de ctrc k2 7 len hib) txt)
@ -3425,11 +3426,11 @@
~/ %puck
|= sk=@I ^- @
?: (gth (met 3 sk) 32) !!
=+ h=(shal (rsh 0 3 b) sk)
=+ h=(shal (rsh [0 3] b) sk)
=+ ^= a
%+ add
(bex (sub b 2))
(lsh 0 3 (cut 0 [3 (sub b 5)] h))
(lsh [0 3] (cut 0 [3 (sub b 5)] h))
=+ aa=(scam bb a)
(etch aa)
:: :: ++suck:ed:crypto
@ -3442,10 +3443,10 @@
~/ %shar
|= [pub=@ sek=@]
^- @ux
=+ exp=(shal (rsh 0 3 b) (suck sek))
=+ exp=(shal (rsh [0 3] b) (suck sek))
=. exp (dis exp (can 0 ~[[3 0] [251 (fil 0 251 1)]]))
=. exp (con exp (lsh 3 31 0b100.0000))
=+ prv=(end 8 1 exp)
=. exp (con exp (lsh [3 31] 0b100.0000))
=+ prv=(end 8 exp)
=+ crv=(fra.fq (sum.fq 1 pub) (dif.fq 1 pub))
(curt prv crv)
:: :: ++sign:ed:crypto
@ -3454,11 +3455,11 @@
|= [m=@ se=@] ^- @
=+ sk=(suck se)
=+ pk=(cut 0 [b b] sk)
=+ h=(shal (rsh 0 3 b) sk)
=+ h=(shal (rsh [0 3] b) sk)
=+ ^= a
%+ add
(bex (sub b 2))
(lsh 0 3 (cut 0 [3 (sub b 5)] h))
(lsh [0 3] (cut 0 [3 (sub b 5)] h))
=+ ^= r
=+ hm=(cut 0 [b b] h)
=+ ^= i
@ -3484,7 +3485,7 @@
|= [s=@ m=@ pk=@] ^- ?
?: (gth (div b 4) (met 3 s)) |
?: (gth (div b 8) (met 3 pk)) |
=+ cb=(rsh 0 3 b)
=+ cb=(rsh [0 3] b)
=+ rr=(deco (cut 0 [0 b] s))
?~ rr |
=+ aa=(deco pk)
@ -3507,7 +3508,7 @@
=+ few==>(fe .(a 5))
=+ ^= rot
|= [a=@ b=@]
(mix (end 5 1 (lsh 0 a b)) (rsh 0 (sub 32 a) b))
(mix (end 5 (lsh [0 a] b)) (rsh [0 (sub 32 a)] b))
=+ ^= lea
|= [a=@ b=@]
(net:few (sum:few (net:few a) (net:few b)))
@ -3623,13 +3624,13 @@
:: :: ++hml:scr:crypto
++ hml :: w+length
|= [k=@ kl=@ t=@ tl=@]
=> .(k (end 3 kl k), t (end 3 tl t))
=> .(k (end [3 kl] k), t (end [3 tl] t))
=+ b=64
=? k (gth kl b) (shay kl k)
=+ ^= q %+ shay (add b tl)
(add (lsh 3 b t) (mix k (fil 3 b 0x36)))
(add (lsh [3 b] t) (mix k (fil 3 b 0x36)))
%+ shay (add b 32)
(add (lsh 3 b q) (mix k (fil 3 b 0x5c)))
(add (lsh [3 b] q) (mix k (fil 3 b 0x5c)))
:: :: ++pbk:scr:crypto
++ pbk :: PBKDF2-HMAC-SHA256
~/ %pbk
@ -3639,7 +3640,7 @@
++ pbl :: w+length
~/ %pbl
|= [p=@ pl=@ s=@ sl=@ c=@ d=@]
=> .(p (end 3 pl p), s (end 3 sl s))
=> .(p (end [3 pl] p), s (end [3 sl] s))
=+ h=32
::
:: max key length 1GB
@ -3656,13 +3657,13 @@
=+ [t=0 j=1 k=1]
=. t |- ^- @
?: (gth j l) t
=+ u=(add s (lsh 3 sl (rep 3 (flop (rpp 3 4 j)))))
=+ u=(add s (lsh [3 sl] (rep 3 (flop (rpp 3 4 j)))))
=+ f=0 =. f |- ^- @
?: (gth k c) f
=+ q=(hml p pl u ?:(=(k 1) (add sl 4) h))
$(u q, f (mix f q), k +(k))
$(t (add t (lsh 3 (mul (dec j) h) f)), j +(j))
(end 3 d t)
$(t (add t (lsh [3 (mul (dec j) h)] f)), j +(j))
(end [3 d] t)
:: :: ++hsh:scr:crypto
++ hsh :: scrypt
~/ %hsh
@ -3673,7 +3674,7 @@
~/ %hsl
|= [p=@ pl=@ s=@ sl=@ n=@ r=@ z=@ d=@]
=| v=(list (list @))
=> .(p (end 3 pl p), s (end 3 sl s))
=> .(p (end [3 pl] p), s (end [3 sl] s))
=+ u=(mul (mul 128 r) z)
::
:: n is power of 2; max 1GB memory
@ -3730,8 +3731,8 @@
|= [bpk=pass msg=@]
^- @ux
?~ sek ~| %pubkey-only !!
?> =('b' (end 3 1 bpk))
=+ pk=(rsh 8 1 (rsh 3 1 bpk))
?> =('b' (end 3 bpk))
=+ pk=(rsh 8 (rsh 3 bpk))
=+ shar=(shax (shar:ed pk cry.u.sek))
=+ smsg=(sign msg)
(jam (~(en siva:aes shar ~) smsg))
@ -3740,8 +3741,8 @@
|= [bpk=pass txt=@]
^- (unit @ux)
?~ sek ~| %pubkey-only !!
?> =('b' (end 3 1 bpk))
=+ pk=(rsh 8 1 (rsh 3 1 bpk))
?> =('b' (end 3 bpk))
=+ pk=(rsh 8 (rsh 3 bpk))
=+ shar=(shax (shar:ed pk cry.u.sek))
=+ ;;([iv=@ len=@ cph=@] (cue txt))
=+ try=(~(de siva:aes shar ~) iv len cph)
@ -3777,7 +3778,7 @@
++ pac :: private fingerprint
^- @uvG
?~ sek ~| %pubkey-only !!
(end 6 1 (shaf %bcod sec))
(end 6 (shaf %bcod sec))
:: :: ++pub:ex:crub:crypto
++ pub :: public key
^- pass
@ -3796,21 +3797,21 @@
|= [w=@ seed=@]
=+ wid=(add (div w 8) ?:(=((mod w 8) 0) 0 1))
=+ bits=(shal wid seed)
=+ [c=(rsh 8 1 bits) s=(end 8 1 bits)]
=+ [c=(rsh 8 bits) s=(end 8 bits)]
..nu(pub [cry=(puck:ed c) sgn=(puck:ed s)], sek `[cry=c sgn=s])
:: :: ++nol:nu:crub:crypto
++ nol :: activate secret
|= a=ring
=+ [mag=(end 3 1 a) bod=(rsh 3 1 a)]
=+ [mag=(end 3 a) bod=(rsh 3 a)]
~| %not-crub-seckey ?> =('B' mag)
=+ [c=(rsh 8 1 bod) s=(end 8 1 bod)]
=+ [c=(rsh 8 bod) s=(end 8 bod)]
..nu(pub [cry=(puck:ed c) sgn=(puck:ed s)], sek `[cry=c sgn=s])
:: :: ++com:nu:crub:crypto
++ com :: activate public
|= a=pass
=+ [mag=(end 3 1 a) bod=(rsh 3 1 a)]
=+ [mag=(end 3 a) bod=(rsh 3 a)]
~| %not-crub-pubkey ?> =('b' mag)
..nu(pub [cry=(rsh 8 1 bod) sgn=(end 8 1 bod)], sek ~)
..nu(pub [cry=(rsh 8 bod) sgn=(end 8 bod)], sek ~)
-- ::nu
-- ::crub
:: ::
@ -3934,7 +3935,7 @@
:- (add p.inp +(pal))
:: padding is provided in lane bit ordering,
:: ie, LSB = left.
(cat 3 (con (lsh 3 pal dsb) 0x80) q.inp)
(cat 3 (con (lsh [3 pal] dsb) 0x80) q.inp)
::
++ sponge
:: sponge construction
@ -3977,7 +3978,7 @@
%+ roll pieces
|= [p=@ s=@]
:: pad with capacity,
=. p (lsh 0 capacity p)
=. p (lsh [0 capacity] p)
:: xor it into the state and permute it.
(permute (mix s (bytes-to-lanes p)))
::
@ -3988,22 +3989,19 @@
:: append a bitrate-sized head of state to the
:: result.
=. res
%+ con (lsh 0 bitrate res)
(rsh 0 capacity (lanes-to-bytes state))
%+ con (lsh [0 bitrate] res)
(rsh [0 capacity] (lanes-to-bytes state))
=. len (add len bitrate)
?: (gte len output)
:: produce the requested bits of output.
(rsh 0 (sub len output) res)
(rsh [0 (sub len output)] res)
$(res res, state (permute state))
::
++ bytes-to-lanes
:: flip byte order in blocks of 8 bytes.
|= a=@
%+ can 6
%+ turn (rip 6 a)
|= b=@
:- 1
(lsh 3 (sub 8 (met 3 b)) (swp 3 b))
%^ run 6 a
|=(b=@ (lsh [3 (sub 8 (met 3 b))] (swp 3 b)))
::
++ lanes-to-bytes
:: unflip byte order in blocks of 8 bytes.
@ -4044,14 +4042,14 @@
=/ c=@
%+ roll (gulf 0 (dec size))
|= [x=@ud c=@]
%+ con (lsh lane-bloq 1 c)
%+ con (lsh [lane-bloq 1] c)
%+ roll (gulf 0 (dec size))
|= [y=@ud c=@]
(mix c (get-lane x y a))
=/ d=@
%+ roll (gulf 0 (dec size))
|= [x=@ud d=@]
%+ con (lsh lane-bloq 1 d)
%+ con (lsh [lane-bloq 1] d)
%+ mix
=- (get-word - size c)
?:(=(x 0) (dec size) (dec x))
@ -4061,8 +4059,8 @@
%+ roll (gulf 0 (dec lanes))
|= [i=@ud a=_a]
%+ mix a
%^ lsh lane-bloq
(sub lanes +(i))
%+ lsh
[lane-bloq (sub lanes +(i))]
(get-word i size d)
::
:: rho and pi
@ -4072,7 +4070,8 @@
=+ x=(mod i 5)
=+ y=(div i 5)
%+ con b
%^ lsh lane-bloq
%+ lsh
:- lane-bloq
%+ sub lanes
%+ add +(y)
%+ mul size
@ -4085,7 +4084,7 @@
=. a
%+ roll (gulf 0 (dec lanes))
|= [i=@ud a=@]
%+ con (lsh lane-bloq 1 a)
%+ con (lsh lane-bloq a)
=+ x=(mod i 5)
=+ y=(div i 5)
%+ mix (get-lane x y b)
@ -4098,7 +4097,7 @@
:: iota
=. a
=+ (round-constant round)
(mix a (lsh lane-bloq (dec lanes) -))
(mix a (lsh [lane-bloq (dec lanes)] -))
::
:: next round
$(round +(round))
@ -4194,20 +4193,20 @@
:: out: bytes output by haj
|* [[haj=$-([@u @] @) boq=@u out=@u] key=byts msg=byts]
:: ensure key and message fit signaled lengths
=. dat.key (end 3 wid.key dat.key)
=. dat.msg (end 3 wid.msg dat.msg)
=. dat.key (end [3 wid.key] dat.key)
=. dat.msg (end [3 wid.msg] dat.msg)
:: keys longer than block size are shortened by hashing
=? dat.key (gth wid.key boq) (haj wid.key dat.key)
=? wid.key (gth wid.key boq) out
:: keys shorter than block size are right-padded
=? dat.key (lth wid.key boq) (lsh 3 (sub boq wid.key) dat.key)
=? dat.key (lth wid.key boq) (lsh [3 (sub boq wid.key)] dat.key)
:: pad key, inner and outer
=+ kip=(mix dat.key (fil 3 boq 0x36))
=+ kop=(mix dat.key (fil 3 boq 0x5c))
:: append inner padding to message, then hash
=+ (haj (add wid.msg boq) (add (lsh 3 wid.msg kip) dat.msg))
=+ (haj (add wid.msg boq) (add (lsh [3 wid.msg] kip) dat.msg))
:: prepend outer padding to result, hash again
(haj (add out boq) (add (lsh 3 out kop) -))
(haj (add out boq) (add (lsh [3 out] kop) -))
-- :: hmac
:: ::
:::: ++secp:crypto :: (2b9) secp family
@ -4252,15 +4251,15 @@
++ decompress-point
|= compressed=@
^- point
=/ x=@ (end 3 bytes compressed)
=/ x=@ (end [3 bytes] compressed)
?> =(3 (mod p.domain 4))
=/ fop field-p
=+ [fadd fmul fpow]=[sum.fop pro.fop exp.fop]
=/ y=@ %+ fpow (rsh 0 2 +(p.domain))
=/ y=@ %+ fpow (rsh [0 2] +(p.domain))
%+ fadd b.domain
%+ fadd (fpow 3 x)
(fmul a.domain x)
=/ s=@ (rsh 3 bytes compressed)
=/ s=@ (rsh [3 bytes] compressed)
~| [`@ux`s `@ux`compressed]
?> |(=(2 s) =(3 s))
:: check parity
@ -4345,8 +4344,8 @@
?: (gte scalar n.domain)
$(scalar (mod scalar n.domain))
?: =(0 (mod scalar 2))
(double $(scalar (rsh 0 1 scalar)))
(add a (double $(scalar (rsh 0 1 scalar))))
(double $(scalar (rsh 0 scalar)))
(add a (double $(scalar (rsh 0 scalar))))
--
++ add-points
|= [a=point b=point]
@ -4468,7 +4467,7 @@
(sub n.domain.c s)
=? rp s-high
[x.rp (sub p.domain.c y.rp)]
=/ v (end 0 1 y.rp)
=/ v (end 0 y.rp)
=? v (gte x.rp n.domain.c)
(add v 2)
[v x.rp s]
@ -4488,8 +4487,8 @@
=/ fop field-p.c
=+ [fadd fmul fpow]=[sum.fop pro.fop exp.fop]
=/ ysq (fadd (fpow 3 x) b.domain.c)
=/ beta (fpow (rsh 0 2 +(p.domain.c)) ysq)
=/ y ?: =((end 0 1 v.sig) (end 0 1 beta))
=/ beta (fpow (rsh [0 2] +(p.domain.c)) ysq)
=/ y ?: =((end 0 v.sig) (end 0 beta))
beta
(sub p.domain.c beta)
?> =(0 (dif.fop ysq (fmul y y)))
@ -4569,22 +4568,22 @@
::
++ pad
|= [byts len=@ud]
(lsh 3 (sub len wid) dat)
(lsh [3 (sub len wid)] dat)
::
++ compress
|= [h=@ c=@ t=@ud l=?]
^- @
:: set up local work vector
=+ v=(add (lsh 6 8 h) iv)
=+ v=(add (lsh [6 8] h) iv)
:: xor the counter t into v
=. v
%- mod-word
:^ v 12 16
(cury mix (end 0 64 t))
(cury mix (end [0 64] t))
=. v
%- mod-word
:^ v 13 16
(cury mix (rsh 0 64 t))
(cury mix (rsh [0 64] t))
:: for the last block, invert v14
=? v l
%- mod-word
@ -4596,8 +4595,8 @@
|^
?: =(i 12)
:: xor upper and lower halves of v into state h
=. h (mix h (rsh 6 8 v))
(mix h (end 6 8 v))
=. h (mix h (rsh [6 8] v))
(mix h (end [6 8] v))
:: select message mixing schedule and mix v
=. s (snag (mod i 10) sigma)
=. v (do-mix 0 4 8 12 0 1)
@ -4647,8 +4646,8 @@
=. out (max 1 (min out 64))
=. wid.msg (min wid.msg (bex 128))
=. wid.key (min wid.key 64)
=. dat.msg (end 3 wid.msg dat.msg)
=. dat.key (end 3 wid.key dat.key)
=. dat.msg (end [3 wid.msg] dat.msg)
=. dat.key (end [3 wid.key] dat.key)
:: initialize state vector
=+ h=iv
:: mix key length and output length into h0
@ -4657,7 +4656,7 @@
:^ h 0 8
%+ cury mix
%+ add 0x101.0000
(add (lsh 3 1 wid.key) out)
(add (lsh 3 wid.key) out)
:: keep track of how much we've compressed
=* mes dat.msg
=+ com=0
@ -4682,7 +4681,7 @@
=. c (pad [rem c] 128)
=. h (compress h c com &)
:: produce output of desired length
%^ rsh 3 (sub 64 out)
%+ rsh [3 (sub 64 out)]
:: do some word
%+ rep 6
%+ turn (flop (gulf 0 7))
@ -4885,7 +4884,7 @@
=/ random-block=@
%+ compress 0
%+ compress 0
%^ lsh 3 968
%+ lsh [3 968]
%+ rep 6
=+ (cury (cury rev 3) 8)
:~ (- counter)
@ -4903,8 +4902,8 @@
%+ turn (flop (rip 6 random-block))
|= a=@
^- (pair @ @)
:- (rev 3 4 (rsh 5 1 a))
(rev 3 4 (end 5 1 a))
:- (rev 3 4 (rsh 5 a))
(rev 3 4 (end 5 a))
::
:: iterate over the entire segment length
::
@ -4951,9 +4950,9 @@
(mul +(seg) seg-length)
:: pseudorandom offset
=- %+ sub (dec -)
%^ rsh 0 32
%+ rsh [0 32]
%+ mul -
(rsh 0 32 (mul c1 c1))
(rsh [0 32] (mul c1 c1))
:: reference area size
?: =(0 itn)
?: |(=(0 seg) =(row ref-row)) (dec col)
@ -5116,7 +5115,7 @@
=+ fed=~(. fe 6)
=* sum sum:fed
=* ror ror:fed
=+ end=(cury (cury end 5) 1)
=+ end=(cury end 5)
=. a :(sum a b :(mul 2 (end a) (end b)))
=. d (ror 0 32 (mix d a))
=. c :(sum c d :(mul 2 (end c) (end d)))
@ -5147,14 +5146,14 @@
:: desired output size.
::
=+ tmp=(blake2b msg 0^0 64)
=+ res=(rsh 3 32 tmp)
=+ res=(rsh [3 32] tmp)
=. out (sub out 32)
|-
?: (gth out 64)
=. tmp (blake2b 64^tmp 0^0 64)
=. res (add (lsh 3 32 res) (rsh 3 32 tmp))
=. res (add (lsh [3 32] res) (rsh [3 32] tmp))
$(out (sub out 32))
%+ add (lsh 3 out res)
%+ add (lsh [3 out] res)
(blake2b 64^tmp 0^0 out)
::
:: utilities
@ -5199,10 +5198,7 @@
:: add padding
=+ (md5-pad wid dat)
:: endianness
=. dat
%+ rep 5
%+ turn (rip 5 dat)
|=(a=@ (rev 3 4 a))
=. dat (run 5 dat |=(a=@ (rev 3 4 a)))
=* x dat
=+ blocks=(div wid 512)
=+ fev=~(. fe 5)
@ -5345,7 +5341,7 @@
=+ (sub 511 (mod (add wid 64) 512))
:- :(add 64 +(-) wid)
%+ can 0
~[64^(rev 3 8 wid) +(-)^(lsh 0 - 1) wid^dat]
~[64^(rev 3 8 wid) +(-)^(lsh [0 -] 1) wid^dat]
--
::
++ pbkdf
@ -5383,7 +5379,7 @@
++ pbkdf
::TODO jet me! ++hmac:hmac is an example
|* [[prf=$-([byts byts] @) out=@u] p=byts s=byts c=@ d=@]
=> .(dat.p (end 3 p), dat.s (end 3 s))
=> .(dat.p (end [3 wid.p] dat.p), dat.s (end [3 wid.s] dat.s))
::
:: max key length 1GB
:: max iterations 2^28
@ -5404,7 +5400,7 @@
?: (gth j l) t
=/ u
%+ add dat.s
%^ lsh 3 wid.s
%+ lsh [3 wid.s]
%+ rep 3
(flop (rpp:scr 3 4 j))
=+ f=0
@ -5416,8 +5412,8 @@
=+ ?:(=(k 1) (add wid.s 4) out)
(prf [wid.p (rev 3 p)] [- (rev 3 - u)])
$(u q, f (mix f q), k +(k))
$(t (add t (lsh 3 (mul (dec j) out) f)), j +(j))
(rev 3 d (end 3 d t))
$(t (add t (lsh [3 (mul (dec j) out)] f)), j +(j))
(rev 3 d (end [3 d] t))
--
-- ::crypto
:: ::::
@ -6182,7 +6178,7 @@
++ en
~/ %en
|= a=octs ^- cord
(crip ((x-co:co (mul p.a 2)) (end 3 p.a q.a)))
(crip ((x-co:co (mul p.a 2)) (end [3 p.a] q.a)))
::
++ de
~/ %de
@ -6192,7 +6188,7 @@
++ rule
%+ cook
|= a=(list @) ^- octs
[(add (dvr (lent a) 2)) (repn 4 (flop a))]
[(add (dvr (lent a) 2)) (rep [0 4] (flop a))]
(star hit)
--
:: :: ++en-base64:mimes:
@ -6200,15 +6196,15 @@
|= tig=@
^- tape
=+ poc=(~(dif fo 3) 0 (met 3 tig))
=+ pad=(lsh 3 poc (swp 3 tig))
=+ pad=(lsh [3 poc] (swp 3 tig))
=+ ^= cha
'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/'
=+ ^= sif
|- ^- tape
?~ pad
~
=+ d=(end 0 6 pad)
[(cut 3 [d 1] cha) $(pad (rsh 0 6 pad))]
=+ d=(end [0 6] pad)
[(cut 3 [d 1] cha) $(pad (rsh [0 6] pad))]
(weld (flop (slag poc sif)) (reap poc '='))
:: :: ++de-base64:mimes:
++ de-base64 :: decode base64
@ -6588,7 +6584,7 @@
=('_' tap)
==
[tap ~]
['%' (xen (rsh 0 4 tap)) (xen (end 0 4 tap)) ~]
['%' (xen (rsh [0 4] tap)) (xen (end [0 4] tap)) ~]
:: :: ++de-urlt:html
++ de-urlt :: url decode
|= tep=tape
@ -6596,7 +6592,7 @@
?~ tep [~ ~]
?: =('%' i.tep)
?. ?=([@ @ *] t.tep) ~
=+ nag=(mix i.t.tep (lsh 3 1 i.t.t.tep))
=+ nag=(mix i.t.tep (lsh 3 i.t.t.tep))
=+ val=(rush nag hex:ag)
?~ val ~
=+ nex=$(tep t.t.t.tep)
@ -6635,7 +6631,7 @@
?:(&(p.har !?=(hoke r.har)) "https://" "http://")
::
?- -.r.har
%| (trip (rsh 3 1 (scot %if p.r.har)))
%| (trip (rsh 3 (scot %if p.r.har)))
%& =+ rit=(flop p.r.har)
|- ^- tape
?~ rit ~
@ -6722,7 +6718,7 @@
++ dlab :: 2396 domainlabel
%+ sear
|= a=@ta
?.(=('-' (rsh 3 (dec (met 3 a)) a)) [~ u=a] ~)
?.(=('-' (rsh [3 (dec (met 3 a))] a)) [~ u=a] ~)
%+ cook |=(a=tape (crip (cass a)))
;~(plug aln (star alp))
:: :: ++fque:de-purl:html
@ -6796,7 +6792,7 @@
|= a=(list @t)
=+ b=(flop a)
?> ?=(^ b)
=+ c=(end 3 1 i.b)
=+ c=(end 3 i.b)
?.(&((gte c 'a') (lte c 'z')) ~ [~ u=b])
(most dot dlab)
::
@ -6976,10 +6972,10 @@
=/ mir (clan who)
?- mir
%czar who
%king (end 3 1 who)
%duke (end 4 1 who)
%earl (end 5 1 who)
%pawn (end 4 1 who)
%king (end 3 who)
%duke (end 4 who)
%earl (end 5 who)
%pawn (end 4 who)
==
--
|%
@ -8342,7 +8338,7 @@
++ address-from-pub
=, keccak:crypto
|= pub=@
%^ end 3 20
%+ end [3 20]
%+ keccak-256 64
(rev 3 64 pub)
::
@ -8668,7 +8664,8 @@
:: rex: string of hex bytes with leading 0x.
|* [rex=@t tys=(list etyp)]
=- (decode-arguments - tys)
%+ turn (rip 9 (rsh 3 2 rex))
%^ rut 9
(rsh [3 2] rex)
(curr rash hex)
::
++ decode-arguments
@ -8738,7 +8735,8 @@
^- octs
:: parse {bys} bytes from {fro}.
:- bys
%^ rsh 3
%+ rsh
:- 3
=+ (mod bys 32)
?:(=(0 -) - (sub 32 -))
%+ rep 8
@ -9193,7 +9191,7 @@
::
++ hex-to-num
|= a=@t
(rash (rsh 3 2 a) hex)
(rash (rsh [3 2] a) hex)
--
::
:: |jstd: json standard library
@ -9375,7 +9373,7 @@
%+ turn u.res
|= [id=@t result=@t]
^- [who=ship point:azimuth-types]
=/ who `@p`(slav %ud (rsh 3 4 id))
=/ who `@p`(slav %ud (rsh [3 4] id))
:- who
%+ point-from-eth
who
@ -9435,7 +9433,7 @@
%+ turn u.res
|= [id=@t result=@t]
^- (pair @ud ^turf)
:- (slav %ud (rsh 3 5 id))
:- (slav %ud (rsh [3 5] id))
=/ dom=tape
(decode-results result [%string]~)
=/ hot=host:eyre

15
pkg/arvo/ted/aqua/ames.hoon
View File

@ -29,23 +29,32 @@
[%event rcvr //newt/0v1n.2m9vh %hear hear-lane pac]~
:: +lane-to-ship: decode a ship from an aqua lane
::
:: Special-case one comet, since its address doesn't fit into a lane.
::
++ lane-to-ship
|= =lane:ames
^- ship
::
?- -.lane
%& p.lane
%| `ship``@`p.lane
%| =/ s `ship``@`p.lane
?. =(s 0xdead.beef.cafe)
s
~bosrym-podwyl-magnes-dacrys--pander-hablep-masrym-marbud
==
:: +ship-to-lane: encode a lane to look like it came from .ship
::
:: Never shows up as a galaxy, because Vere wouldn't know that either.
:: Special-case one comet, since its address doesn't fit into a lane.
::
++ ship-to-lane
|= =ship
^- lane:ames
::
[%| `address:ames``@`ship]
:- %|
^- address:ames ^- @
?. =(ship ~bosrym-podwyl-magnes-dacrys--pander-hablep-masrym-marbud)
ship
0xdead.beef.cafe
--
::
%+ aqua-vane-thread ~[%restore %send]

4
pkg/arvo/ted/aqua/eyre-azimuth.hoon
View File

@ -426,8 +426,8 @@
::
++ get-public
|= [who=@p lyfe=life typ=?(%auth %crypt)]
=/ bod (rsh 3 1 pub:ex:(get-keys who lyfe))
=+ [enc=(rsh 8 1 bod) aut=(end 8 1 bod)]
=/ bod (rsh 3 pub:ex:(get-keys who lyfe))
=+ [enc=(rsh 8 bod) aut=(end 8 bod)]
?: =(%auth typ)
aut
enc

8
pkg/arvo/ted/eth/send-txs.hoon
View File

@ -25,7 +25,7 @@
%+ request-batch-rpc-loose:ethio url
%+ turn (scag step-size txs)
|= tx=@ux
:- `(scot %ux (end 3 10 tx))
:- `(scot %ux (end [3 10] tx))
[%eth-send-raw-transaction tx]
:: parse tx hashes out of responses, bailing on submission failure
::
@ -42,9 +42,9 @@
==
::
%error
?: ?| =('known transaction' (end 3 17 message.res))
=('Known transaction' (end 3 17 message.res))
=('Transaction with the same ' (end 3 26 message.res))
?: ?| =('known transaction' (end [3 17] message.res))
=('Known transaction' (end [3 17] message.res))
=('Transaction with the same ' (end [3 26] message.res))
==
~& [%sent-a-known-transaction--skipping id.res]
$(responses t.responses)

12
pkg/arvo/ted/ph/hi-comet-az.hoon
View File

@ -8,13 +8,19 @@
;< az=tid:spider
bind:m start-azimuth
;< ~ bind:m (spawn az ~bud)
;< ~ bind:m (spawn az ~marbud)
;< ~ bind:m (spawn az ~linnup-torsyx)
;< ~ bind:m (real-ship az ~bud)
::
;< ~ bind:m (spawn az ~marbud)
;< ~ bind:m (real-ship az ~marbud)
;< ~ bind:m (real-ship az ~linnup-torsyx)
::
;< ~ bind:m (real-ship az comet)
;< ~ bind:m (send-hi comet ~bud)
::
;< ~ bind:m (spawn az ~linnup-torsyx)
;< ~ bind:m (real-ship az ~linnup-torsyx)
::
;< ~ bind:m (send-hi comet ~linnup-torsyx)
;< ~ bind:m (send-hi ~linnup-torsyx comet)
::
;< ~ bind:m end-azimuth
(pure:m *vase)

2
pkg/arvo/ted/test.hoon
View File

@ -71,7 +71,7 @@
::
++ has-test-prefix
|= a=term ^- ?
=((end 3 5 a) 'test-')
=((end [3 5] a) 'test-')
::
++ find-test-files
=| fiz=(set [=beam test=(unit term)])

24
pkg/arvo/tests/sys/hoon/bits.hoon
View File

@ -7,49 +7,49 @@
::
%+ expect-eq
!> ~[0x3 0x7 0x7]
!> (flop (ripn 3 0xff))
!> (flop (rip [0 3] 0xff))
%+ expect-eq
!> ~[0x1 0xee 0xff]
!> (flop (ripn 8 0x1.eeff))
!> (flop (rip [0 8] 0x1.eeff))
%+ expect-eq
!> ~[0x1 0xe 0xe 0xf 0xf]
!> (flop (ripn 4 0x1.eeff))
!> (flop (rip [0 4] 0x1.eeff))
::
:: Typical use-cases
::
%+ expect-eq
!> ~[0x1 0x23.4567 0x89.abcd]
!> (flop (ripn 24 0x1.2345.6789.abcd))
!> (flop (rip [0 24] 0x1.2345.6789.abcd))
::
:: Edge cases
::
%+ expect-eq
!> ~
!> (flop (ripn 31 0x0))
!> (flop (rip [0 31] 0x0))
%+ expect-eq
!> ~
!> (flop (ripn 1 0x0))
!> (flop (rip [0 1] 0x0))
::
:: Word boundaries
::
%+ expect-eq
!> ~[0x7fff.ffff]
!> (flop (ripn 31 0x7fff.ffff))
!> (flop (rip [0 31] 0x7fff.ffff))
%+ expect-eq
!> ~[0x1 0x7fff.ffff]
!> (flop (ripn 31 0xffff.ffff))
!> (flop (rip [0 31] 0xffff.ffff))
%+ expect-eq
!> ~[0x3 0x7fff.ffff]
!> (flop (ripn 31 0x1.ffff.ffff))
!> (flop (rip [0 31] 0x1.ffff.ffff))
%+ expect-eq
!> ~[0x3 0x7fff.ffff 0x7fff.ffff]
!> (flop (ripn 31 0xffff.ffff.ffff.ffff))
!> (flop (rip [0 31] 0xffff.ffff.ffff.ffff))
%+ expect-eq
!> ~[0x1 0x1.ffff 0x1.ffff]
!> (flop (ripn 17 0x7.ffff.ffff))
!> (flop (rip [0 17] 0x7.ffff.ffff))
%+ expect-eq
!> ~[0x123 0x456 0x789 0xabc 0xdef 0x12 0x345 0x678]
!> (flop (ripn 12 0x1234.5678.9abc.def0.1234.5678))
!> (flop (rip [0 12] 0x1234.5678.9abc.def0.1234.5678))
==
::
--

153
pkg/arvo/tests/sys/vane/ames.hoon
View File

@ -6,31 +6,43 @@
::
=/ nec vane
=/ bud vane
=/ comet vane
::
=. our.nec ~nec
=. now.nec ~1111.1.1
=. eny.nec 0xdead.beef
=. our.nec ~nec
=. now.nec ~1111.1.1
=. eny.nec 0xdead.beef
=. life.ames-state.nec 2
=. rof.nec |=(* ``[%noun !>(*(list turf))])
::
=. our.bud ~bud
=. now.bud ~1111.1.1
=. eny.bud 0xbeef.dead
=. rof.bud |=(* ``[%noun !>(*(list turf))])
::
=. crypto-core.ames-state.nec (pit:nu:crub:crypto 512 (shaz 'nec'))
=. crypto-core.ames-state.bud (pit:nu:crub:crypto 512 (shaz 'bud'))
::
=/ nec-pub pub:ex:crypto-core.ames-state.nec
=/ nec-sec sec:ex:crypto-core.ames-state.nec
::
=. our.bud ~bud
=. now.bud ~1111.1.1
=. eny.bud 0xbeef.dead
=. life.ames-state.bud 3
=. rof.bud |=(* ``[%noun !>(*(list turf))])
=. crypto-core.ames-state.bud (pit:nu:crub:crypto 512 (shaz 'bud'))
=/ bud-pub pub:ex:crypto-core.ames-state.bud
=/ bud-sec sec:ex:crypto-core.ames-state.bud
::
=. our.comet ~bosrym-podwyl-magnes-dacrys--pander-hablep-masrym-marbud
=. now.comet ~1111.1.1
=. eny.comet 0xbeef.cafe
=. rof.comet |=(* ``[%noun !>(*(list turf))])
=. crypto-core.ames-state.comet
%- nol:nu:crub:crypto
0w9N.5uIvA.Jg0cx.NCD2R.o~MtZ.uEQOB.9uTbp.6LHvg.0yYTP.
3q3td.T4UF0.d5sDL.JGpZq.S3A92.QUuWg.IHdw7.izyny.j9W92
=/ comet-pub pub:ex:crypto-core.ames-state.comet
=/ comet-sec sec:ex:crypto-core.ames-state.comet
::
=/ nec-sym (derive-symmetric-key:vane bud-pub nec-sec)
=/ bud-sym (derive-symmetric-key:vane nec-pub bud-sec)
::
?> =(nec-sym bud-sym)
::
=. life.ames-state.nec 2
=/ comet-sym (derive-symmetric-key:vane bud-pub comet-sec)
::
=. peers.ames-state.nec
%+ ~(put by peers.ames-state.nec) ~bud
=| =peer-state:ames
@ -43,7 +55,6 @@
=. route.peer-state `[direct=%.y `lane:ames`[%& ~nec]]
[%known peer-state]
::
=. life.ames-state.bud 3
=. peers.ames-state.bud
%+ ~(put by peers.ames-state.bud) ~nec
=| =peer-state:ames
@ -106,9 +117,10 @@
::
=/ =packet:ames
:* [sndr=~nec rcvr=~bud]
encrypted=%.n
sndr-tick=0b10
rcvr-tick=0b11
origin=~
content=[12 13]
content=0xdead.beef
==
::
=/ encoded (encode-packet:vane packet)
@ -118,6 +130,50 @@
!> packet
!> decoded
::
++ test-origin-encoding ^- tang
::
=/ =packet:ames
:* [sndr=~nec rcvr=~bud]
sndr-tick=0b10
rcvr-tick=0b11
origin=`0xbeef.cafe.beef
content=0xdead.beef
==
::
=/ encoded (encode-packet:vane packet)
=/ decoded (decode-packet:vane encoded)
::
%+ expect-eq
!> packet
!> decoded
::
++ test-shut-packet-encoding ^- tang
::
=/ =shut-packet:ames
:+ bone=17 message-num=18
[%& num-fragments=1 fragment-num=1 fragment=`@`0xdead.beef]
::
=/ =packet:ames
(encode-shut-packet:ames shut-packet nec-sym ~marnec ~marbud-marbud 3 17)
::
=/ decoded (decode-shut-packet:ames packet nec-sym 3 17)
::
%+ expect-eq
!> shut-packet
!> decoded
::
++ test-shut-packet-associated-data ^- tang
::
=/ =shut-packet:ames
:+ bone=17 message-num=18
[%& num-fragments=1 fragment-num=1 fragment=`@`0xdead.beef]
::
=/ =packet:ames
(encode-shut-packet:ames shut-packet nec-sym ~marnec ~marbud-marbud 3 1)
::
%- expect-fail
|.((decode-shut-packet:ames packet nec-sym 3 17))
::
++ test-alien-encounter ^- tang
::
=/ lane-foo=lane:ames [%| `@ux``@`%lane-foo]
@ -125,18 +181,19 @@
=/ =plea:ames [%g /talk [%first %post]]
::
=/ =shut-packet:ames
:* sndr-life=4
rcvr-life=3
bone=1
:* bone=1
message-num=1
[%& num-fragments=1 fragment-num=0 (jam plea)]
==
::
=/ =packet:ames
:* [sndr=~bus rcvr=~bud]
encrypted=%.y
origin=~
content=(encrypt:vane nec-sym shut-packet)
%: encode-shut-packet:vane
shut-packet
nec-sym
~bus
~bud
sndr-life=4
rcvr-life=3
==
::
=/ =blob:ames (encode-packet:vane packet)
@ -170,6 +227,56 @@
!> (sy ,.moves3)
==
::
++ test-comet-encounter ^- tang
::
=/ lane-foo=lane:ames [%| `@ux``@`%lane-foo]
::
=/ =open-packet:ames
:* public-key=`@`comet-pub
sndr=our.comet
sndr-life=1
rcvr=~bud
rcvr-life=3
==
=/ packet
(encode-open-packet:vane open-packet crypto-core.ames-state.comet)
=/ blob (encode-packet:vane packet)
::
=^ moves0 bud (call bud ~[//unix] %hear lane-foo blob)
::
=/ =plea:ames [%g /talk [%first %post]]
=/ =shut-packet:ames
:* bone=1
message-num=1
[%& num-fragments=1 fragment-num=0 (jam plea)]
==
=/ =packet:ames
%: encode-shut-packet:vane
shut-packet
comet-sym
our.comet
~bud
sndr-life=1
rcvr-life=3
==
=/ blob (encode-packet:vane packet)
=^ moves1 bud (call bud ~[//unix] %hear lane-foo blob)
::
;: weld
%+ expect-eq
!> ~
!> moves0
::
%+ expect-eq
!> :~ :* ~[//unix] %pass /qos %d %flog %text
"; {<our.comet>} is your neighbor"
==
:* ~[//unix] %pass /bone/(scot %p our.comet)/1
%g %plea our.comet plea
== ==
!> moves1
==
::
++ test-message-flow ^- tang
:: ~nec -> %plea -> ~bud
::

2
pkg/arvo/tests/sys/zuse/crypto/ripemd.hoon
View File

@ -20,7 +20,7 @@
%+ category
:: only first 100 chars, meme happens for super long values
::
(trip (end 3 100 msg))
(trip (end [3 100] msg))
%+ expect-eq
!> out.i.ves
!> `@ux`(ripemd-160 wid (rev 3 wid msg))

25
pkg/hs/urbit-king/lib/Urbit/Arvo/Effect.hs
View File

@ -13,6 +13,7 @@ import Urbit.Noun.Time
import Urbit.Prelude
import Control.Monad.Fail (fail)
import Numeric.Natural (Natural)
import Urbit.Arvo.Common (KingId(..), ServId(..))
import Urbit.Arvo.Common (Header, HttpEvent, HttpServerConf, Method, Mime)
import Urbit.Arvo.Common (AmesDest, Turf)
@ -144,6 +145,7 @@ data Tint
| TintK
| TintW
| TintNull
| TintTrue Word8 Word8 Word8
deriving (Eq, Ord, Show)
data Stye = Stye
@ -174,19 +176,24 @@ instance FromNoun Deco where
instance ToNoun Tint where
toNoun = \case
TintR -> toNoun $ Cord "r"
TintG -> toNoun $ Cord "g"
TintB -> toNoun $ Cord "b"
TintC -> toNoun $ Cord "c"
TintM -> toNoun $ Cord "m"
TintY -> toNoun $ Cord "y"
TintK -> toNoun $ Cord "k"
TintW -> toNoun $ Cord "w"
TintNull -> Atom 0
TintR -> toNoun $ Cord "r"
TintG -> toNoun $ Cord "g"
TintB -> toNoun $ Cord "b"
TintC -> toNoun $ Cord "c"
TintM -> toNoun $ Cord "m"
TintY -> toNoun $ Cord "y"
TintK -> toNoun $ Cord "k"
TintW -> toNoun $ Cord "w"
TintNull -> Atom 0
TintTrue r g b -> Cell (atom r) $ Cell (atom g) (atom b)
where atom a = Atom (fromIntegral a :: Natural)
instance FromNoun Tint where
parseNoun = named "Tint" . \case
Atom 0 -> pure TintNull
Cell (Atom r) (Cell (Atom g) (Atom b))
-> pure (TintTrue (word r) (word g) (word b))
where word w = fromIntegral w :: Word8
n -> parseNoun @Cord n <&> unCord >>= \case
"r" -> pure TintR
"g" -> pure TintG

26
pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs
View File

@ -391,17 +391,19 @@ localClient doneSignal = fst <$> mkRAcquire start stop
DecoBl -> '5'
DecoNull -> '0'
termRenderTint :: Tint -> Char
termRenderTint :: Tint -> [Char]
termRenderTint = \case
TintK -> '0'
TintR -> '1'
TintG -> '2'
TintY -> '3'
TintB -> '4'
TintM -> '5'
TintC -> '6'
TintW -> '7'
TintNull -> '9'
TintK -> ['0']
TintR -> ['1']
TintG -> ['2']
TintY -> ['3']
TintB -> ['4']
TintM -> ['5']
TintC -> ['6']
TintW -> ['7']
TintNull -> ['9']
TintTrue r g b ->
mconcat ["8;2;", show r, ";", show g, ";", show b]
-- Wraps the appropriate escape sequence around a piece of styled text
termRenderStubSegment :: Stye -> [Char] -> [Char]
@ -417,10 +419,10 @@ localClient doneSignal = fst <$> mkRAcquire start stop
[ intersperse ';' $ fmap termRenderDeco $ toList decoset
, case back of
TintNull -> []
tint -> ['4', termRenderTint tint]
tint -> '4' : termRenderTint tint
, case fore of
TintNull -> []
tint -> ['3', termRenderTint tint]
tint -> '3' : termRenderTint tint
]
styled = mconcat [escape, styles, "m", tape, escape, "0m"]

6
pkg/interface/src/views/apps/term/components/line.js
View File

@ -31,7 +31,7 @@ export default React.memo(({line}) => {
case 'y': prop.color = 'yellow'; break;
case 'k': prop.color = 'black'; break;
case 'w': prop.color = 'white'; break;
default: console.log('weird fore', part.stye.fore);
default: prop.color = '#' + part.stye.fore;
}
switch (part.stye.back) {
case null: break;
@ -43,7 +43,7 @@ export default React.memo(({line}) => {
case 'y': prop.backgroundColor = 'yellow'; break;
case 'k': prop.backgroundColor = 'black'; break;
case 'w': prop.backgroundColor = 'white'; break;
default: console.log('weird back', part.stye.back);
default: prop.backgroundColor = '#' + part.stye.back;
}
if (Object.keys(prop).length === 0)
{
@ -59,7 +59,7 @@ export default React.memo(({line}) => {
// render line
//
return (
<Text color='black' mono display='block' fontSize='0'
<Text color='black' mono display='flex' fontSize='0'
style={{ overflowWrap: 'break-word', whiteSpace: 'pre-wrap' }}
>
{text}

8
pkg/urbit/include/jets/k.h
View File

@ -43,12 +43,16 @@
/* u3kc_rep(): assemble single.
*/
u3_noun
u3kc_rep(u3_atom a, u3_noun b);
u3kc_rep(u3_atom a,
u3_atom b,
u3_noun c);
/* u3kc_rip(): disassemble.
*/
u3_noun
u3kc_rip(u3_atom a, u3_atom b);
u3kc_rip(u3_atom a,
u3_atom b,
u3_atom c);
/* u3kc_rev(): reverse block order, accounting for leading zeroes.
*/

4
pkg/urbit/include/jets/q.h
View File

@ -63,9 +63,9 @@
u3_noun u3qc_peg(u3_atom, u3_atom);
u3_noun u3qc_pow(u3_atom, u3_atom);
u3_noun u3qc_rap(u3_atom, u3_noun);
u3_noun u3qc_rep(u3_atom, u3_noun);
u3_noun u3qc_rep(u3_atom, u3_atom, u3_noun);
u3_noun u3qc_rev(u3_atom, u3_atom, u3_atom);
u3_noun u3qc_rip(u3_atom, u3_atom);
u3_noun u3qc_rip(u3_atom, u3_atom, u3_atom);
u3_noun u3qc_rsh(u3_atom, u3_atom, u3_atom);
u3_noun u3qc_swp(u3_atom, u3_atom);
u3_noun u3qc_sqt(u3_atom);

2
pkg/urbit/include/jets/w.h
View File

@ -69,8 +69,6 @@
u3_noun u3wc_rep(u3_noun);
u3_noun u3wc_rev(u3_noun);
u3_noun u3wc_rip(u3_noun);
u3_noun u3wc_repn(u3_noun);
u3_noun u3wc_ripn(u3_noun);
u3_noun u3wc_rsh(u3_noun);
u3_noun u3wc_swp(u3_noun);
u3_noun u3wc_sqt(u3_noun);

5
pkg/urbit/include/noun/retrieve.h
View File

@ -188,6 +188,11 @@
u3_noun* b,
u3_noun* c);
/* u3r_bite(): retrieve/default $bloq and $step from $bite.
*/
c3_o
u3r_bite(u3_noun bite, u3_atom* bloq, u3_atom *step);
/* u3r_cell():
**
** Divide `a` as a cell `[b c]`.

5
pkg/urbit/include/noun/xtract.h
View File

@ -98,6 +98,11 @@
void
u3x_mean(u3_noun a, ...);
/* u3x_bite(): xtract/default $bloq and $step from $bite.
*/
void
u3x_bite(u3_noun bite, u3_atom* bloq, u3_atom *step);
/* u3x_cell():
**
** Divide `a` as a cell `[b c]`.

75
pkg/urbit/jets/c/end.c
View File

@ -3,56 +3,47 @@
*/
#include "all.h"
u3_noun
u3qc_end(u3_atom a,
u3_atom b,
u3_atom c)
{
if ( !_(u3a_is_cat(a)) || (a >= 32) ) {
return u3m_bail(c3__fail);
}
else if ( !_(u3a_is_cat(b)) ) {
return u3k(c);
}
else {
c3_g a_g = a;
c3_w b_w = b;
c3_w len_w = u3r_met(a_g, c);
/* functions
*/
u3_noun
u3qc_end(u3_atom a,
u3_atom b,
u3_atom c)
{
if ( !_(u3a_is_cat(a)) || (a >= 32) ) {
return u3m_bail(c3__fail);
if ( 0 == b_w ) {
return 0;
}
else if ( !_(u3a_is_cat(b)) ) {
else if ( b_w >= len_w ) {
return u3k(c);
}
else {
c3_g a_g = a;
c3_w b_w = b;
c3_w len_w = u3r_met(a_g, c);
u3i_slab sab_u;
u3i_slab_init(&sab_u, a_g, b_w);
if ( 0 == b_w ) {
return 0;
}
else if ( b_w >= len_w ) {
return u3k(c);
}
else {
u3i_slab sab_u;
u3i_slab_init(&sab_u, a_g, b_w);
u3r_chop(a_g, 0, b_w, 0, sab_u.buf_w, c);
u3r_chop(a_g, 0, b_w, 0, sab_u.buf_w, c);
return u3i_slab_mint(&sab_u);
}
return u3i_slab_mint(&sab_u);
}
}
u3_noun
u3wc_end(u3_noun cor)
{
u3_noun a, b, c;
}
if ( (c3n == u3r_mean(cor, u3x_sam_2, &a,
u3x_sam_6, &b,
u3x_sam_7, &c, 0)) ||
(c3n == u3ud(a)) ||
(c3n == u3ud(b)) ||
(c3n == u3ud(c)) )
{
return u3m_bail(c3__exit);
} else {
return u3qc_end(a, b, c);
}
}
u3_noun
u3wc_end(u3_noun cor)
{
u3_atom bloq, step;
u3_noun a, b;
u3x_mean(cor, u3x_sam_2, &a,
u3x_sam_3, &b, 0);
u3x_bite(a, &bloq, &step);
return u3qc_end(bloq, step, u3x_atom(b));
}

96
pkg/urbit/jets/c/lsh.c
View File

@ -3,66 +3,58 @@
*/
#include "all.h"
u3_noun
u3qc_lsh(u3_atom a,
u3_atom b,
u3_atom c)
{
if ( !_(u3a_is_cat(a)) || (a >= 32) ) {
return u3m_bail(c3__fail);
}
else if ( !_(u3a_is_cat(b)) ) {
return u3m_bail(c3__fail);
}
else {
c3_g a_g = a;
c3_w b_w = b;
c3_w len_w = u3r_met(a_g, c);
/* functions
*/
u3_noun
u3qc_lsh(u3_atom a,
u3_atom b,
u3_atom c)
{
if ( !_(u3a_is_cat(a)) || (a >= 32) ) {
return u3m_bail(c3__fail);
if ( 0 == len_w ) {
return 0;
}
else if ( !_(u3a_is_cat(b)) ) {
return u3m_bail(c3__fail);
else if ( (b_w + len_w) < len_w ) {
return u3m_bail(c3__exit);
}
else {
c3_g a_g = a;
c3_w b_w = b;
c3_w len_w = u3r_met(a_g, c);
u3i_slab sab_u;
u3i_slab_init(&sab_u, a_g, (b_w + len_w));
if ( 0 == len_w ) {
return 0;
}
else if ( (b_w + len_w) < len_w ) {
return u3m_bail(c3__exit);
}
else {
u3i_slab sab_u;
u3i_slab_init(&sab_u, a_g, (b_w + len_w));
u3r_chop(a_g, 0, len_w, b_w, sab_u.buf_w, c);
u3r_chop(a_g, 0, len_w, b_w, sab_u.buf_w, c);
return u3i_slab_mint(&sab_u);
}
return u3i_slab_mint(&sab_u);
}
}
u3_noun
u3wc_lsh(u3_noun cor)
{
u3_noun a, b, c;
}
if ( (c3n == u3r_mean(cor, u3x_sam_2, &a,
u3x_sam_6, &b,
u3x_sam_7, &c, 0)) ||
(c3n == u3ud(a)) ||
(c3n == u3ud(b)) ||
(c3n == u3ud(c)) )
{
return u3m_bail(c3__exit);
} else {
return u3qc_lsh(a, b, c);
}
}
u3_noun
u3kc_lsh(u3_noun a,
u3_noun b,
u3_noun c)
{
u3_noun d = u3qc_lsh(a, b, c);
u3_noun
u3wc_lsh(u3_noun cor)
{
u3_atom bloq, step;
u3_noun a, b;
u3x_mean(cor, u3x_sam_2, &a,
u3x_sam_3, &b, 0);
u3x_bite(a, &bloq, &step);
u3z(a); u3z(b); u3z(c);
return d;
}
return u3qc_lsh(bloq, step, u3x_atom(b));
}
u3_noun
u3kc_lsh(u3_noun a,
u3_noun b,
u3_noun c)
{
u3_noun d = u3qc_lsh(a, b, c);
u3z(a); u3z(b); u3z(c);
return d;
}

256
pkg/urbit/jets/c/rep.c
View File

@ -3,92 +3,194 @@
*/
#include "all.h"
/* functions
/*
Get the lowest `n` bits of a word `w` using a bitmask.
*/
u3_noun
u3qc_rep(u3_atom a,
u3_noun b)
#define TAKEBITS(n,w) \
((n)==32) ? (w) : \
((n)==0) ? 0 : \
((w) & ((1 << (n)) - 1))
/*
Divide, rounding up.
*/
#define DIVCEIL(x,y) \
(x==0) ? 0 : \
1 + ((x - 1) / y);
static u3_noun
_bit_rep(u3_atom bits, u3_noun blox)
{
if ( (c3n == u3a_is_cat(bits) || bits==0 || bits>31) ) {
return u3m_bail(c3__fail);
}
//
// Calculate input and output size.
//
c3_w num_blox_w = u3qb_lent(blox);
c3_w bit_widt_w = num_blox_w * bits;
c3_w wor_widt_w = DIVCEIL(bit_widt_w, 32);
u3i_slab sab_u;
u3i_slab_bare(&sab_u, 5, wor_widt_w);
//
// Fill the atom buffer with bits from each block.
//
// Bits are pushed into the `acc_w` register and flushed to the buffer
// once full.
//
// acc_w register
// use_w number of register bits filled (used)
// cur_w next buffer word to flush into.
//
{
if ( !_(u3a_is_cat(a)) || (a >= 32) ) {
return u3m_bail(c3__exit);
c3_w acc_w=0, use_w=0, *cur_w=sab_u.buf_w;
# define FLUSH() *cur_w++=acc_w; acc_w=use_w=0
# define SLICE(sz,off,val) TAKEBITS(sz, val) << off
for (c3_w i=0; i<num_blox_w; i++) {
u3_noun blok_n = u3h(blox);
blox = u3t(blox);
if ( c3n == u3a_is_cat(blok_n) ) {
return u3m_bail(c3__fail);
}
c3_w blok_w = blok_n;
for (c3_w rem_in_blok_w=bits; rem_in_blok_w;) {
c3_w rem_in_acc_w = 32 - use_w;
if (rem_in_blok_w == rem_in_acc_w) { // EQ
acc_w |= SLICE(rem_in_blok_w, use_w, blok_w);
FLUSH();
rem_in_blok_w = 0;
}
else if (rem_in_blok_w < rem_in_acc_w) { // LT
acc_w |= SLICE(rem_in_blok_w, use_w, blok_w);
use_w += rem_in_blok_w;
rem_in_blok_w = 0;
}
else { // GT
acc_w |= SLICE(rem_in_acc_w, use_w, blok_w);
rem_in_blok_w -= rem_in_acc_w;
blok_w = blok_w >> rem_in_acc_w;
FLUSH();
}
}
}
else {
c3_g a_g = a;
c3_w tot_w = 0;
u3i_slab sab_u;
/* Measure and validate the slab required.
*/
{
u3_noun cab = b;
while ( 1 ) {
u3_noun h_cab;
c3_w len_w;
if ( 0 == cab ) {
break;
}
else if ( c3n == u3du(cab) ) {
return u3m_bail(c3__exit);
}
else if ( c3n == u3ud(h_cab = u3h(cab)) ) {
return u3m_bail(c3__exit);
}
else if ( (tot_w + (len_w = u3r_met(a_g, h_cab))) < tot_w ) {
return u3m_bail(c3__fail);
}
tot_w++;
cab = u3t(cab);
}
if ( 0 == tot_w ) {
return 0;
}
u3i_slab_init(&sab_u, a_g, tot_w);
}
/* Chop the list atoms in.
*/
{
u3_noun cab = b;
c3_w pos_w = 0;
while ( 0 != cab ) {
u3_noun h_cab = u3h(cab);
u3r_chop(a_g, 0, 1, pos_w, sab_u.buf_w, h_cab);
pos_w++;
cab = u3t(cab);
}
}
return u3i_slab_mint(&sab_u);
//
// If the last word isn't fully used, it will still need to be
// flushed.
//
if (use_w) {
FLUSH();
}
}
u3_noun
u3wc_rep(u3_noun cor)
{
u3_noun a, b;
if ( (c3n == u3r_mean(cor, u3x_sam_2, &a, u3x_sam_3, &b, 0)) ||
(c3n == u3ud(a)) )
return u3i_slab_mint(&sab_u);
}
static u3_noun
_block_rep(u3_atom a,
u3_noun b)
{
if ( !_(u3a_is_cat(a)) || (a >= 32) ) {
return u3m_bail(c3__exit);
}
else {
c3_g a_g = a;
c3_w tot_w = 0;
u3i_slab sab_u;
/* Measure and validate the slab required.
*/
{
return u3m_bail(c3__exit);
} else {
u3_noun pro;
u3_noun cab = b;
pro = u3qc_rep(a, b);
return pro;
while ( 1 ) {
u3_noun h_cab;
c3_w len_w;
if ( 0 == cab ) {
break;
}
else if ( c3n == u3du(cab) ) {
return u3m_bail(c3__exit);
}
else if ( c3n == u3ud(h_cab = u3h(cab)) ) {
return u3m_bail(c3__exit);
}
else if ( (tot_w + (len_w = u3r_met(a_g, h_cab))) < tot_w ) {
return u3m_bail(c3__fail);
}
tot_w++;
cab = u3t(cab);
}
if ( 0 == tot_w ) {
return 0;
}
u3i_slab_init(&sab_u, a_g, tot_w);
}
/* Chop the list atoms in.
*/
{
u3_noun cab = b;
c3_w pos_w = 0;
while ( 0 != cab ) {
u3_noun h_cab = u3h(cab);
u3r_chop(a_g, 0, 1, pos_w, sab_u.buf_w, h_cab);
pos_w++;
cab = u3t(cab);
}
}
return u3i_slab_mint(&sab_u);
}
u3_noun
u3kc_rep(u3_atom a,
u3_noun b)
{
u3_noun res = u3qc_rep(a, b);
u3z(a); u3z(b);
return res;
}
u3_noun
u3qc_rep(u3_atom a,
u3_atom b,
u3_noun c)
{
if ( 1 == b ) {
return _block_rep(a, c);
}
if ( 0 == a ) {
return _bit_rep(b, c);
}
u3l_log("rep: stub\r\n");
return u3m_bail(c3__fail);
}
u3_noun
u3wc_rep(u3_noun cor)
{
u3_atom bloq, step;
u3_noun a, b;
u3x_mean(cor, u3x_sam_2, &a,
u3x_sam_3, &b, 0);
u3x_bite(a, &bloq, &step);
return u3qc_rep(bloq, step, b);
}
u3_noun
u3kc_rep(u3_atom a,
u3_atom b,
u3_noun c)
{
u3_noun res = u3qc_rep(a, b, c);
u3z(a); u3z(b); u3z(c);
return res;
}

113
pkg/urbit/jets/c/repn.c
View File

@ -1,113 +0,0 @@
#include "all.h"
/*
Get the lowest `n` bits of a word `w` using a bitmask.
*/
#define TAKEBITS(n,w) \
((n)==32) ? (w) : \
((n)==0) ? 0 : \
((w) & ((1 << (n)) - 1))
/*
Divide, rounding up.
*/
#define DIVCEIL(x,y) \
(x==0) ? 0 : \
1 + ((x - 1) / y);
u3_noun
u3qc_repn(u3_atom bits, u3_noun blox)
{
if ( (c3n == u3a_is_cat(bits) || bits==0 || bits>31) ) {
return u3m_bail(c3__fail);
}
//
// Calculate input and output size.
//
c3_w num_blox_w = u3qb_lent(blox);
c3_w bit_widt_w = num_blox_w * bits;
c3_w wor_widt_w = DIVCEIL(bit_widt_w, 32);
u3i_slab sab_u;
u3i_slab_bare(&sab_u, 5, wor_widt_w);
//
// Fill the atom buffer with bits from each block.
//
// Bits are pushed into the `acc_w` register and flushed to the buffer
// once full.
//
// acc_w register
// use_w number of register bits filled (used)
// cur_w next buffer word to flush into.
//
{
c3_w acc_w=0, use_w=0, *cur_w=sab_u.buf_w;
# define FLUSH() *cur_w++=acc_w; acc_w=use_w=0
# define SLICE(sz,off,val) TAKEBITS(sz, val) << off
for (c3_w i=0; i<num_blox_w; i++) {
u3_noun blok_n = u3h(blox);
blox = u3t(blox);
if ( c3n == u3a_is_cat(blok_n) ) {
return u3m_bail(c3__fail);
}
c3_w blok_w = blok_n;
for (c3_w rem_in_blok_w=bits; rem_in_blok_w;) {
c3_w rem_in_acc_w = 32 - use_w;
if (rem_in_blok_w == rem_in_acc_w) { // EQ
acc_w |= SLICE(rem_in_blok_w, use_w, blok_w);
FLUSH();
rem_in_blok_w = 0;
}
else if (rem_in_blok_w < rem_in_acc_w) { // LT
acc_w |= SLICE(rem_in_blok_w, use_w, blok_w);
use_w += rem_in_blok_w;
rem_in_blok_w = 0;
}
else { // GT
acc_w |= SLICE(rem_in_acc_w, use_w, blok_w);
rem_in_blok_w -= rem_in_acc_w;
blok_w = blok_w >> rem_in_acc_w;
FLUSH();
}
}
}
//
// If the last word isn't fully used, it will still need to be
// flushed.
//
if (use_w) {
FLUSH();
}
}
return u3i_slab_mint(&sab_u);
}
u3_noun
u3wc_repn(u3_noun cor)
{
u3_noun bits, blox;
if ( (c3n == u3r_mean(cor, u3x_sam_2, &bits, u3x_sam_3, &blox, 0)) ||
(c3n == u3ud(bits)) )
{
return u3m_bail(c3__exit);
}
return u3qc_repn(bits, blox);
}
u3_noun
u3kc_repn(u3_atom bits, u3_atom blox)
{
u3_noun res = u3qc_repn(bits, blox);
u3z(bits); u3z(blox);
return res;
}

132
pkg/urbit/jets/c/rip.c
View File

@ -1,6 +1,90 @@
#include "all.h"
u3_noun u3qc_rip(u3_atom bloq, u3_atom b) {
/*
Get the lowest `n` bits of a word `w` using a bitmask.
*/
#define TAKEBITS(n,w) \
((n)==32) ? (w) : \
((n)==0) ? 0 : \
((w) & ((1 << (n)) - 1))
/*
Divide, rounding up.
*/
#define DIVCEIL(x,y) \
(x==0) ? 0 : \
1 + ((x - 1) / y);
/*
`ripn` breaks `atom` into a list of blocks, of bit-width `bits`. The
resulting list will be least-significant block first.
XX TODO This only handles cases where the bit-width is <= 32.
For each block we produce, we need to grab the relevant words inside
`atom`, so we first compute their indicies.
`ins_idx` is the word-index of the least-significant word we
care about, and `sig_idx` is the word after that.
Next we grab those words (`ins_word` and `sig_word`) from the atom
using `u3r_word`. Note that `sig_idx` might be out-of-bounds for the
underlying array of `atom`, but `u3r_word` returns 0 in that case,
which is exatly what we want.
Now, we need to grab the relevant bits out of both words, and combine
them. `bits_rem_in_ins_word` is the number of remaining (insignificant)
bits in `ins_word`, `nbits_ins` is the number of bits we want from the
less-significant word, and `nbits_sig` from the more-significant one.
Take the least significant `nbits_sig` bits from `sig_word`, and take
the slice we care about from `ins_word`. In order to take that slice,
we drop `bits_rem_in_ins_word` insignificant bits, and then take the
`nbits_sig` most-significant bits.
Last, we slice out those bits from the two words, combine them into
one word, and cons them onto the front of the result.
*/
static u3_noun
_bit_rip(u3_atom bits, u3_atom atom)
{
if ( !_(u3a_is_cat(bits) || bits==0 || bits>31) ) {
return u3m_bail(c3__fail);
}
c3_w bit_width = u3r_met(0, atom);
c3_w num_blocks = DIVCEIL(bit_width, bits);
u3_noun res = u3_nul;
for ( c3_w blk = 0; blk < num_blocks; blk++ ) {
c3_w next_blk = blk + 1;
c3_w blks_rem = num_blocks - next_blk;
c3_w bits_rem = blks_rem * bits;
c3_w ins_idx = bits_rem / 32;
c3_w sig_idx = ins_idx + 1;
c3_w bits_rem_in_ins_word = bits_rem % 32;
c3_w ins_word = u3r_word(ins_idx, atom);
c3_w sig_word = u3r_word(sig_idx, atom);
c3_w nbits_ins = c3_min(bits, 32 - bits_rem_in_ins_word);
c3_w nbits_sig = bits - nbits_ins;
c3_w ins_word_bits = TAKEBITS(nbits_ins, ins_word >> bits_rem_in_ins_word);
c3_w sig_word_bits = TAKEBITS(nbits_sig, sig_word);
c3_w item = ins_word_bits | (sig_word_bits << nbits_ins);
res = u3nc(item, res);
}
return res;
}
static u3_noun
_block_rip(u3_atom bloq, u3_atom b)
{
if ( !_(u3a_is_cat(bloq)) || (bloq >= 32) ) {
return u3m_bail(c3__fail);
}
@ -62,21 +146,41 @@ u3_noun u3qc_rip(u3_atom bloq, u3_atom b) {
return acc;
}
u3_noun u3wc_rip(u3_noun cor) {
u3_noun a, b;
if ( (c3n == u3r_mean(cor, u3x_sam_2, &a, u3x_sam_3, &b, 0)) ||
(c3n == u3ud(a)) ||
(c3n == u3ud(b))
) {
return u3m_bail(c3__exit);
u3_noun
u3qc_rip(u3_atom a,
u3_atom b,
u3_atom c)
{
if ( 1 == b ) {
return _block_rip(a, c);
}
return u3qc_rip(a, b);
if ( 0 == a ) {
return _bit_rip(b, c);
}
u3l_log("rip: stub\r\n");
return u3m_bail(c3__fail);
}
u3_noun u3kc_rip(u3_atom a, u3_atom b) {
u3_noun res = u3qc_rip(a, b);
u3z(a); u3z(b);
return res;
u3_noun
u3wc_rip(u3_noun cor)
{
u3_atom bloq, step;
u3_noun a, b;
u3x_mean(cor, u3x_sam_2, &a,
u3x_sam_3, &b, 0);
u3x_bite(a, &bloq, &step);
return u3qc_rip(bloq, step, u3x_atom(b));
}
u3_noun
u3kc_rip(u3_atom a,
u3_atom b,
u3_atom c)
{
u3_noun pro = u3qc_rip(a, b, c);
u3z(a); u3z(b); u3z(c);
return pro;
}

100
pkg/urbit/jets/c/ripn.c
View File

@ -1,100 +0,0 @@
#include "all.h"
/*
Get the lowest `n` bits of a word `w` using a bitmask.
*/
#define TAKEBITS(n,w) \
((n)==32) ? (w) : \
((n)==0) ? 0 : \
((w) & ((1 << (n)) - 1))
/*
Divide, rounding up.
*/
#define DIVCEIL(x,y) \
(x==0) ? 0 : \
1 + ((x - 1) / y);
/*
`ripn` breaks `atom` into a list of blocks, of bit-width `bits`. The
resulting list will be least-significant block first.
XX TODO This only handles cases where the bit-width is <= 32.
For each block we produce, we need to grab the relevant words inside
`atom`, so we first compute their indicies.
`ins_idx` is the word-index of the least-significant word we
care about, and `sig_idx` is the word after that.
Next we grab those words (`ins_word` and `sig_word`) from the atom
using `u3r_word`. Note that `sig_idx` might be out-of-bounds for the
underlying array of `atom`, but `u3r_word` returns 0 in that case,
which is exatly what we want.
Now, we need to grab the relevant bits out of both words, and combine
them. `bits_rem_in_ins_word` is the number of remaining (insignificant)
bits in `ins_word`, `nbits_ins` is the number of bits we want from the
less-significant word, and `nbits_sig` from the more-significant one.
Take the least significant `nbits_sig` bits from `sig_word`, and take
the slice we care about from `ins_word`. In order to take that slice,
we drop `bits_rem_in_ins_word` insignificant bits, and then take the
`nbits_sig` most-significant bits.
Last, we slice out those bits from the two words, combine them into
one word, and cons them onto the front of the result.
*/
u3_noun u3qc_ripn(u3_atom bits, u3_atom atom) {
if ( !_(u3a_is_cat(bits) || bits==0 || bits>31) ) {
return u3m_bail(c3__fail);
}
c3_w bit_width = u3r_met(0, atom);
c3_w num_blocks = DIVCEIL(bit_width, bits);
u3_noun res = u3_nul;
for ( c3_w blk = 0; blk < num_blocks; blk++ ) {
c3_w next_blk = blk + 1;
c3_w blks_rem = num_blocks - next_blk;
c3_w bits_rem = blks_rem * bits;
c3_w ins_idx = bits_rem / 32;
c3_w sig_idx = ins_idx + 1;
c3_w bits_rem_in_ins_word = bits_rem % 32;
c3_w ins_word = u3r_word(ins_idx, atom);
c3_w sig_word = u3r_word(sig_idx, atom);
c3_w nbits_ins = c3_min(bits, 32 - bits_rem_in_ins_word);
c3_w nbits_sig = bits - nbits_ins;
c3_w ins_word_bits = TAKEBITS(nbits_ins, ins_word >> bits_rem_in_ins_word);
c3_w sig_word_bits = TAKEBITS(nbits_sig, sig_word);
c3_w item = ins_word_bits | (sig_word_bits << nbits_ins);
res = u3nc(item, res);
}
return res;
}
u3_noun u3wc_ripn(u3_noun cor) {
u3_noun bits, atom;
if ( (c3n == u3r_mean(cor, u3x_sam_2, &bits, u3x_sam_3, &atom, 0)) ||
(c3n == u3ud(bits)) ||
(c3n == u3ud(atom)) )
{
return u3m_bail(c3__exit);
}
return u3qc_ripn(bits, atom);
}
u3_noun u3kc_ripn(u3_atom bits, u3_atom atom) {
u3_noun res = u3qc_ripn(bits, atom);
u3z(bits), u3z(atom);
return res;
}

90
pkg/urbit/jets/c/rsh.c
View File

@ -3,63 +3,55 @@
*/
#include "all.h"
u3_noun
u3qc_rsh(u3_atom a,
u3_atom b,
u3_atom c)
{
if ( !_(u3a_is_cat(a)) || (a >= 32) ) {
return u3m_bail(c3__fail);
}
else if ( !_(u3a_is_cat(b)) ) {
return 0;
}
else {
c3_g a_g = a;
c3_w b_w = b;
c3_w len_w = u3r_met(a_g, c);
/* functions
*/
u3_noun
u3qc_rsh(u3_atom a,
u3_atom b,
u3_atom c)
{
if ( !_(u3a_is_cat(a)) || (a >= 32) ) {
return u3m_bail(c3__fail);
}
else if ( !_(u3a_is_cat(b)) ) {
if ( b_w >= len_w ) {
return 0;
}
else {
c3_g a_g = a;
c3_w b_w = b;
c3_w len_w = u3r_met(a_g, c);
u3i_slab sab_u;
u3i_slab_init(&sab_u, a_g, (len_w - b_w));
if ( b_w >= len_w ) {
return 0;
}
else {
u3i_slab sab_u;
u3i_slab_init(&sab_u, a_g, (len_w - b_w));
u3r_chop(a_g, b_w, (len_w - b_w), 0, sab_u.buf_w, c);
u3r_chop(a_g, b_w, (len_w - b_w), 0, sab_u.buf_w, c);
return u3i_slab_mint(&sab_u);
}
return u3i_slab_mint(&sab_u);
}
}
u3_noun
u3wc_rsh(u3_noun cor)
{
u3_noun a, b, c;
}
if ( (c3n == u3r_mean(cor, u3x_sam_2, &a,
u3x_sam_6, &b,
u3x_sam_7, &c, 0)) ||
(c3n == u3ud(a)) ||
(c3n == u3ud(b)) ||
(c3n == u3ud(c)) )
{
return u3m_bail(c3__exit);
} else {
return u3qc_rsh(a, b, c);
}
}
u3_noun
u3kc_rsh(u3_noun a,
u3_noun b,
u3_noun c)
{
u3_noun d = u3qc_rsh(a, b, c);
u3_noun
u3wc_rsh(u3_noun cor)
{
u3_atom bloq, step;
u3_noun a, b;
u3x_mean(cor, u3x_sam_2, &a,
u3x_sam_3, &b, 0);
u3x_bite(a, &bloq, &step);
u3z(a); u3z(b); u3z(c);
return d;
}
return u3qc_rsh(bloq, step, u3x_atom(b));
}
u3_noun
u3kc_rsh(u3_noun a,
u3_noun b,
u3_noun c)
{
u3_noun d = u3qc_rsh(a, b, c);
u3z(a); u3z(b); u3z(c);
return d;
}

56
pkg/urbit/jets/c/swp.c
View File

@ -3,37 +3,35 @@
*/
#include "all.h"
/* functions
*/
u3_noun
u3qc_swp(u3_atom a,
u3_atom b)
{
//XX write a proper c-style swp, maybe
//
return u3kc_rep(u3k(a), 1, u3kb_flop(u3qc_rip(a, 1, b)));
}
u3_noun
u3qc_swp(u3_atom a,
u3_atom b)
u3_noun
u3wc_swp(u3_noun cor)
{
u3_noun a, b;
u3x_mean(cor, u3x_sam_2, &a, u3x_sam_3, &b, 0);
if ( (c3n == u3ud(a))
|| (c3n == u3ud(b)) )
{
//XX write a proper c-style swp, maybe
return u3kc_rep(u3k(a), u3kb_flop(u3qc_rip(a, b)));
return u3m_bail(c3__exit);
}
u3_noun
u3wc_swp(u3_noun cor)
{
u3_noun a, b;
return u3qc_swp(a, b);
}
if ( (c3n == u3r_mean(cor, u3x_sam_2, &a, u3x_sam_3, &b, 0)) ||
(c3n == u3ud(a)) ||
(c3n == u3ud(b)) )
{
return u3m_bail(c3__exit);
} else {
return u3qc_swp(a, b);
}
}
u3_noun
u3kc_swp(u3_atom a,
u3_atom b)
{
u3_noun res = u3qc_swp(a, b);
u3z(a); u3z(b);
return res;
}
u3_noun
u3kc_swp(u3_atom a,
u3_atom b)
{
u3_noun pro = u3qc_swp(a, b);
u3z(a); u3z(b);
return pro;
}

6
pkg/urbit/jets/e/aes_siv.c
View File

@ -104,6 +104,10 @@ static u3_noun _siv_de(c3_y* key_y,
return u3_none;
}
if ( c3y == u3qa_gth(u3r_met(3, txt), len) ) {
return u3_none;
}
while (u3_nul != ads) {
c3_w ad_w = u3r_met(3, u3h(ads));
c3_y* ad_y = u3a_malloc(ad_w);
@ -327,7 +331,7 @@ u3qea_sivc_de(u3_atom key,
u3_atom txt)
{
c3_y key_y[64];
if (u3r_met(3, key) > 64) {
if ( u3r_met(3, key) > 64 ) {
return u3_none;
}

47
pkg/urbit/jets/e/trip.c
View File

@ -3,33 +3,28 @@
*/
#include "all.h"
u3_noun
u3qe_trip(u3_atom a)
{
return u3qc_rip(3, 1, a);
}
/* functions
*/
u3_noun
u3qe_trip(u3_atom a)
{
if ( c3n == u3ud(a) ) {
return u3m_bail(c3__exit);
}
return u3qc_rip(3, a);
}
u3_noun
u3we_trip(u3_noun cor)
{
u3_noun a;
u3_noun
u3we_trip(u3_noun cor)
{
u3_noun a = u3x_at(u3x_sam, cor);
if ( (u3_none == (a = u3r_at(u3x_sam, cor))) ) {
return u3m_bail(c3__fail);
} else {
return u3qe_trip(a);
}
if ( c3n == u3ud(a) ) {
return u3m_bail(c3__exit);
}
u3_atom
u3ke_trip(u3_noun a)
{
u3_atom b = u3qe_trip(a);
u3z(a);
return b;
}
return u3qe_trip(a);
}
u3_atom
u3ke_trip(u3_noun a)
{
u3_atom pro = u3qe_trip(a);
u3z(a);
return pro;
}

19
pkg/urbit/jets/tree.c
View File

@ -2,7 +2,7 @@
To generate the hashes, take the sha256 of the jammed battery. For example:
```
> `@ux`(shax (jam -:ripn))
> `@ux`(shax (jam -:rip))
0x2759.a693.1e9e.f9a5.2c8e.ee43.1088.43d9.4d39.32a6.b04f.86cb.6ba1.5553.4329.3a28
```
@ -944,9 +944,9 @@ static u3j_core _141_qua_d[] =
{ "mole", 7, _141_qua_mole_a, 0, _141_qua_mole_ha },
{ "mule", 7, _141_qua_mule_a, 0, _141_qua_mule_ha },
{ "scot", 7, _141_qua_scot_a, 0, _141_qua_scot_ha },
{ "scow", 7, _141_qua_scow_a, 0, _141_qua_scow_ha },
{ "slaw", 7, _141_qua_slaw_a, 0, _141_qua_slaw_ha },
// { "scot", 7, _141_qua_scot_a, 0, _141_qua_scot_ha },
// { "scow", 7, _141_qua_scow_a, 0, _141_qua_scow_ha },
// { "slaw", 7, _141_qua_slaw_a, 0, _141_qua_slaw_ha },
{}
};
static c3_c* _141_qua_ha[] = {
@ -1572,15 +1572,6 @@ static c3_c* _141_two_rip_ha[] = {
"e8e0b834aded0d2738bcf38a93bf373d412a51e0cee7f274277a6393e634a65e",
0
};
static u3j_harm _141_two_repn_a[] = {{".2", u3wc_repn, c3y}, {}};
static c3_c* _141_two_repn_ha[] = {
0
};
static u3j_harm _141_two_ripn_a[] = {{".2", u3wc_ripn, c3y}, {}};
static c3_c* _141_two_ripn_ha[] = {
"2759a6931e9ef9a52c8eee43108843d94d3932a6b04f86cb6ba1555343293a28",
0
};
static u3j_harm _141_two_rsh_a[] = {{".2", u3wc_rsh, c3y}, {}};
static c3_c* _141_two_rsh_ha[] = {
"a401145b4c11ec8d17a729fe30f06c295865ffed1b970b0a788f0fec1ed0a703",
@ -1868,8 +1859,6 @@ static u3j_core _141_two_d[] =
{ "rep", 7, _141_two_rep_a, 0, _141_two_rep_ha },
{ "rev", 7, _141_two_rev_a, 0, _141_two_rev_ha },
{ "rip", 7, _141_two_rip_a, 0, _141_two_rip_ha },
{ "repn", 7, _141_two_repn_a, 0, _141_two_repn_ha },
{ "ripn", 7, _141_two_ripn_a, 0, _141_two_ripn_ha },
{ "rsh", 7, _141_two_rsh_a, 0, _141_two_rsh_ha },
{ "swp", 7, _141_two_swp_a, 0, _141_two_swp_ha },
{ "rub", 7, _141_two_rub_a, 0, _141_two_rub_ha },

24
pkg/urbit/noun/retrieve.c
View File

@ -805,6 +805,30 @@ u3r_bush(u3_noun a,
}
}
/* u3r_bite(): retrieve/default $bloq and $step from $bite.
*/
c3_o
u3r_bite(u3_noun bite, u3_atom* bloq, u3_atom *step)
{
u3_noun hed, tal;
if ( c3n == u3r_cell(bite, &hed, &tal) ) {
*bloq = bite;
*step = 1;
return c3y;
}
else if ( (c3n == u3a_is_atom(hed))
|| (c3n == u3a_is_atom(tal)) )
{
return c3n;
}
else {
*bloq = hed;
*step = tal;
return c3y;
}
}
/* u3r_cell():
**
** Factor (a) as a cell (b c).

10
pkg/urbit/noun/xtract.c
View File

@ -39,6 +39,16 @@ u3x_mean(u3_noun som, ...)
}
}
/* u3x_bite(): xtract/default $bloq and $step from $bite.
*/
void
u3x_bite(u3_noun bite, u3_atom* bloq, u3_atom *step)
{
if ( c3n == u3r_bite(bite, bloq, step) ) {
u3m_bail(c3__exit);
}
}
/* u3x_cell():
**
** Divide `a` as a cell `[b c]`.

295
pkg/urbit/vere/io/ames.c
View File

@ -66,11 +66,12 @@
/* u3_head: ames packet header
*/
typedef struct _u3_head {
c3_o sim_o; // is ames protocol?
c3_y ver_y; // protocol version
c3_l mug_l; // truncated mug hash of u3_body
c3_y sac_y; // sender class
c3_y rac_y; // receiver class
c3_o enc_o; // encrypted?
c3_l mug_l; // truncated mug hash of u3_body
c3_o rel_o; // relayed?
} u3_head;
/* u3_body: ames packet body
@ -78,8 +79,12 @@
typedef struct _u3_body {
c3_d sen_d[2]; // sender
c3_d rec_d[2]; // receiver
c3_w con_w; // jam size
c3_y* con_y; // (jam [origin content])
c3_y sic_y; // sender life tick
c3_y ric_y; // receiver life tick
c3_s con_s; // content size
c3_y* con_y; // content
c3_d rog_d; // origin lane (optional)
c3_l mug_l; // checksum
} u3_body;
/* u3_panc: deconstructed incoming packet
@ -140,14 +145,6 @@ _ames_panc_free(u3_panc* pac_u)
c3_free(pac_u);
}
/* _ames_mug_body(): truncated (20 least-significant bits) mug hash of bytes
*/
static c3_l
_ames_mug_body(c3_w len_w, c3_y* byt_y)
{
return u3r_mug_bytes(byt_y, len_w) & 0xfffff;
}
/* _ames_sift_head(): parse packet header.
*/
static c3_o
@ -158,36 +155,20 @@ _ames_sift_head(u3_head* hed_u, c3_y buf_y[4])
| (buf_y[2] << 16)
| (buf_y[3] << 24);
// XX only version 0 currently recognized
// first three bits are reserved
//
hed_u->ver_y = hed_w & 0x7;
hed_u->mug_l = (hed_w >> 3) & 0xfffff; // 20 bits
hed_u->sac_y = (hed_w >> 23) & 0x3;
hed_u->rac_y = (hed_w >> 25) & 0x3;
hed_u->enc_o = (hed_w >> 27) & 0x1;
return c3y;
hed_u->sim_o = (hed_w >> 3) & 0x1;
hed_u->ver_y = (hed_w >> 4) & 0x7;
hed_u->sac_y = (hed_w >> 7) & 0x3;
hed_u->rac_y = (hed_w >> 9) & 0x3;
hed_u->mug_l = (hed_w >> 11) & 0xfffff; // 20 bits
hed_u->rel_o = (hed_w >> 31) & 0x1;
// reject packets that don't even claim to be ames packets
//
return hed_u->sim_o;
}
/* _ames_etch_head(): serialize packet header.
*/
static void
_ames_etch_head(u3_head* hed_u, c3_y buf_y[4])
{
c3_w hed_w = hed_u->ver_y
| (hed_u->mug_l << 3)
| (hed_u->sac_y << 23)
| (hed_u->rac_y << 25)
| (hed_u->enc_o << 27);
// only version 0 currently recognized
//
c3_assert( 0 == hed_u->ver_y );
buf_y[0] = hed_w & 0xff;
buf_y[1] = (hed_w >> 8) & 0xff;
buf_y[2] = (hed_w >> 16) & 0xff;
buf_y[3] = (hed_w >> 24) & 0xff;
}
/* _ames_chub_bytes(): c3_y[8] to c3_d
** XX factor out, deduplicate with other conversions
@ -254,57 +235,106 @@ _ames_sift_body(u3_head* hed_u,
c3_w len_w,
c3_y* bod_y)
{
c3_y sen_y = 2 << hed_u->sac_y;
c3_y rec_y = 2 << hed_u->rac_y;
c3_y rog_y, sen_y, rec_y;
if ( (sen_y + rec_y) >= len_w ) {
rog_y = ( c3y == hed_u->rel_o )? 6 : 0;
sen_y = 2 << hed_u->sac_y;
rec_y = 2 << hed_u->rac_y;
if ( (1 + sen_y + rec_y + rog_y) >= len_w ) {
return c3n;
}
else {
_ames_ship_to_chubs(bod_u->sen_d, sen_y, bod_y);
_ames_ship_to_chubs(bod_u->rec_d, rec_y, bod_y + sen_y);
c3_y* gob_y;
c3_s gob_s;
if ( rog_y) {
c3_y rag_y[8] = {0};
memcpy(rag_y, bod_y, rog_y);
bod_u->rog_d = _ames_chub_bytes(rag_y);
}
else {
bod_u->rog_d = 0;
}
gob_y = bod_y + rog_y;
gob_s = len_w - rog_y;
bod_u->mug_l = u3r_mug_bytes(gob_y, gob_s) & 0xfffff;
bod_u->sic_y = gob_y[0] & 0xf;
bod_u->ric_y = (gob_y[0] >> 4) & 0xf;
_ames_ship_to_chubs(bod_u->sen_d, sen_y, gob_y + 1);
_ames_ship_to_chubs(bod_u->rec_d, rec_y, gob_y + 1 + sen_y);
bod_u->con_s = gob_s - 1 - sen_y - rec_y;
bod_u->con_y = gob_y + 1 + sen_y + rec_y;
bod_u->con_w = len_w - sen_y - rec_y;
bod_u->con_y = bod_y + sen_y + rec_y;
return c3y;
}
}
/* _ames_etch_head(): serialize packet header.
*/
static void
_ames_etch_head(u3_head* hed_u, c3_y buf_y[4])
{
c3_w hed_w = ((hed_u->sim_o & 0x1) << 3)
^ ((hed_u->ver_y & 0x7) << 4)
^ ((hed_u->sac_y & 0x3) << 7)
^ ((hed_u->rac_y & 0x3) << 9)
^ ((hed_u->mug_l & 0xfffff) << 11)
^ ((hed_u->rel_o & 0x1) << 31);
// only version 0 currently recognized
//
c3_assert( 0 == hed_u->ver_y ); // XX remove after testing
buf_y[0] = hed_w & 0xff;
buf_y[1] = (hed_w >> 8) & 0xff;
buf_y[2] = (hed_w >> 16) & 0xff;
buf_y[3] = (hed_w >> 24) & 0xff;
}
/* _ames_etch_pack(): serialize packet header and body.
*/
static c3_w
_ames_etch_pack(u3_head* hed_u,
u3_body* bod_u,
c3_o mug_o,
c3_y** out_y)
{
// start with the body
//
c3_y sen_y = 2 << hed_u->sac_y; // sender len
c3_y rec_y = 2 << hed_u->rac_y; // receiver len
c3_w bod_w = sen_y + rec_y + bod_u->con_w; // body len
c3_w len_w = 4 + bod_w; // packet len
c3_y* pac_y = c3_malloc(len_w);
c3_y* bod_y = pac_y + 4;
c3_y sen_y = 2 << hed_u->sac_y; // sender len
c3_y rec_y = 2 << hed_u->rac_y; // receiver len
c3_y rog_y = ( c3y == hed_u->rel_o )? 6 : 0; // origin len
c3_w bod_w = rog_y + 1 + sen_y + rec_y + bod_u->con_s; // body len
c3_w len_w = 4 + bod_w; // packet len
c3_y* pac_y = c3_malloc(len_w); // output buf
c3_y* bod_y = pac_y + 4; // body cursor
c3_y* gob_y = bod_y + rog_y; // after origin
_ames_ship_of_chubs(bod_u->sen_d, sen_y, bod_y);
_ames_ship_of_chubs(bod_u->rec_d, rec_y, bod_y + sen_y);
{
c3_y* con_y = bod_y + sen_y + rec_y;
memcpy(con_y, bod_u->con_y, bod_u->con_w);
}
// if we updated the origin lane, we need to update the mug too
//
if ( c3y == mug_o ) {
hed_u->mug_l = _ames_mug_body(bod_w, bod_y);
}
// now we can serialize the head
// serialize the head
//
_ames_etch_head(hed_u, pac_y);
// serialize the origin, if present
//
if ( rog_y ) {
c3_y rag_y[8] = {0};
_ames_bytes_chub(rag_y, bod_u->rog_d);
memcpy(bod_y, rag_y, rog_y);
}
// serialize the body
//
gob_y[0] = (bod_u->sic_y & 0xf) ^ ((bod_u->ric_y & 0xf) << 4);
_ames_ship_of_chubs(bod_u->sen_d, sen_y, gob_y + 1);
_ames_ship_of_chubs(bod_u->rec_d, rec_y, gob_y + 1 + sen_y);
memcpy(gob_y + 1 + sen_y + rec_y, bod_u->con_y, bod_u->con_s);
*out_y = pac_y;
return len_w;
}
@ -371,28 +401,29 @@ _ames_send(u3_pact* pac_u)
*/
u3_lane
u3_ames_decode_lane(u3_atom lan) {
u3_noun cud, tag, pip, por;
cud = u3ke_cue(lan);
u3x_trel(cud, &tag, &pip, &por);
c3_assert( c3__ipv4 == tag );
u3_lane lan_u;
lan_u.pip_w = u3r_word(0, pip);
c3_d lan_d;
c3_assert( _(u3a_is_cat(por)) );
c3_assert( por < 65536 );
lan_u.por_s = por;
c3_assert( c3y == u3r_safe_chub(lan, &lan_d) );
u3z(lan);
u3z(cud);
lan_u.pip_w = (c3_w)lan_d;
lan_u.por_s = (c3_s)(lan_d >> 32);
return lan_u;
}
/* u3_ames_encode_lane(): serialize lane to jammed noun
/* u3_ames_lane_to_chub(): serialize lane to double-word
*/
c3_d
u3_ames_lane_to_chub(u3_lane lan) {
return ((c3_d)lan.por_s << 32) ^ (c3_d)lan.pip_w;
}
/* u3_ames_encode_lane(): serialize lane to noun
*/
u3_atom
u3_ames_encode_lane(u3_lane lan) {
return u3ke_jam(u3nt(c3__ipv4, u3i_words(1, &lan.pip_w), lan.por_s));
return u3i_chub(u3_ames_lane_to_chub(lan));
}
/* _ames_lane_into_cache(): put las for who into cache, including timestamp
@ -438,57 +469,18 @@ _ames_lane_from_cache(u3p(u3h_root) lax_p, u3_noun who) {
static u3_noun
_ames_serialize_packet(u3_panc* pac_u, c3_o dop_o)
{
c3_o nal_o = c3n;
// update the body's lane, if desired
// update the body's lane, if:
// - we're supposed to (dop_o)
// - it hasn't already been updated (rel_o)
// - sender is not a galaxy
//
if ( c3y == dop_o ) {
// unpack (jam [(unit lane) body])
//
u3_noun lon, bod;
{
//NOTE we checked for cue safety in _ames_recv_cb
//
u3_weak old = u3s_cue_xeno_with(pac_u->sam_u->sil_u,
pac_u->bod_u.con_w,
pac_u->bod_u.con_y);
u3x_cell(u3x_good(old), &lon, &bod);
u3k(lon); u3k(bod);
u3z(old);
}
// only replace the lane if it was ~
//
//NOTE this sets an opaque lane even in the "sender is galaxy" case,
// but that doesn't matter: ames.hoon ignores origin in that case,
// always using the appropriate galaxy lane instead.
//
if ( u3_nul == lon ) {
c3_w con_w;
c3_y* con_y;
u3z(lon);
lon = u3nt(u3_nul, c3n, u3_ames_encode_lane(pac_u->ore_u));
nal_o = c3y;
// XX off-loom jam?
//
{
u3_noun jam = u3ke_jam(u3nc(lon, bod));
con_w = u3r_met(3, jam);
con_y = c3_malloc(con_w);
u3r_bytes(0, con_w, con_y, jam);
u3z(jam);
}
c3_free(pac_u->ptr_v);
pac_u->ptr_v = con_y;
pac_u->bod_u.con_y = con_y;
pac_u->bod_u.con_w = con_w;
}
else {
u3z(lon); u3z(bod);
}
if ( c3y == dop_o
&& c3n == pac_u->hed_u.rel_o
&& !( ( 256 > pac_u->bod_u.sen_d[0] )
&& ( 0 == pac_u->bod_u.sen_d[1] ) ) )
{
pac_u->hed_u.rel_o = c3y;
pac_u->bod_u.rog_d = u3_ames_lane_to_chub(pac_u->ore_u);
}
// serialize the packet
@ -500,7 +492,7 @@ _ames_serialize_packet(u3_panc* pac_u, c3_o dop_o)
c3_y* pac_y;
c3_w len_w = _ames_etch_pack(&pac_u->hed_u,
&pac_u->bod_u,
nal_o, &pac_y);
&pac_y);
pac = u3i_bytes(len_w, pac_y);
c3_free(pac_y);
@ -989,7 +981,8 @@ _ames_try_forward(u3_ames* sam_u,
if ( (u3_none == lac) && (1000 < sam_u->sat_u.foq_d) ) {
sam_u->sat_u.fod_d++;
if ( 0 == (sam_u->sat_u.fod_d % 10000) ) {
u3l_log("ames: dropped %" PRIu64 " forwards total\n", sam_u->sat_u.fod_d);
u3l_log("ames: dropped %" PRIu64 " forwards total\n",
sam_u->sat_u.fod_d);
}
c3_free(hun_y);
@ -1042,7 +1035,7 @@ _ames_try_forward(u3_ames* sam_u,
}
}
/* _ames_hear(): parse a (potential packet), dispatch appropriately.
/* _ames_hear(): parse a (potential) packet, dispatch appropriately.
*/
static void
_ames_hear(u3_ames* sam_u,
@ -1073,7 +1066,8 @@ _ames_hear(u3_ames* sam_u,
{
sam_u->sat_u.hed_d++;
if ( 0 == (sam_u->sat_u.hed_d % 100) ) {
u3l_log("ames: %" PRIu64 " dropped, failed to read header\n", sam_u->sat_u.hed_d);
u3l_log("ames: %" PRIu64 " dropped, failed to read header\n",
sam_u->sat_u.hed_d);
}
c3_free(hun_y);
@ -1089,7 +1083,8 @@ _ames_hear(u3_ames* sam_u,
{
sam_u->sat_u.vet_d++;
if ( 0 == (sam_u->sat_u.vet_d % 100) ) {
u3l_log("ames: %" PRIu64 " dropped for version mismatch\n", sam_u->sat_u.vet_d);
u3l_log("ames: %" PRIu64 " dropped for version mismatch\n",
sam_u->sat_u.vet_d);
}
c3_free(hun_y);
@ -1100,26 +1095,26 @@ _ames_hear(u3_ames* sam_u,
c3_w bod_w = len_w - 4;
c3_y* bod_y = hun_y + 4;
// ensure the mug is valid
// unpack and validate the body
//
if ( _ames_mug_body(bod_w, bod_y) != hed_u.mug_l ) {
sam_u->sat_u.mut_d++;
if ( 0 == (sam_u->sat_u.mut_d % 100) ) {
u3l_log("ames: %" PRIu64 " dropped for invalid mug\n", sam_u->sat_u.mut_d);
if ( (c3n == _ames_sift_body(&hed_u, &bod_u, bod_w, bod_y)) ) {
sam_u->sat_u.bod_d++;
if ( 0 == (sam_u->sat_u.bod_d % 100) ) {
u3l_log("ames: %" PRIu64 " dropped, failed to read body\n",
sam_u->sat_u.bod_d);
}
c3_free(hun_y);
return;
}
// unpack and validate the body
// ensure the mug is valid
//
if ( (c3n == _ames_sift_body(&hed_u, &bod_u, bod_w, bod_y))
|| !ur_cue_test_with(sam_u->tes_u, bod_u.con_w, bod_u.con_y) )
{
sam_u->sat_u.bod_d++;
if ( 0 == (sam_u->sat_u.bod_d % 100) ) {
u3l_log("ames: %" PRIu64 " dropped, failed to read body\n", sam_u->sat_u.bod_d);
if ( bod_u.mug_l != hed_u.mug_l ) {
sam_u->sat_u.mut_d++;
if ( 0 == (sam_u->sat_u.mut_d % 100) ) {
u3l_log("ames: %" PRIu64 " dropped for invalid mug\n",
sam_u->sat_u.mut_d);
}
c3_free(hun_y);

91
pkg/urbit/vere/io/term.c
View File

@ -1128,23 +1128,72 @@ u3_term_ef_ctlc(void)
_term_it_refresh_line(uty_u);
}
/* _term_it_put_value(): put numeric color value on lin_w.
*/
static c3_w
_term_it_put_value(c3_w* lin_w,
u3_atom val)
{
c3_c str_c[4];
c3_w len = snprintf(str_c, 4, "%d", val % 256);
for ( c3_w i_w = 0; i_w < len; i_w++ ) {
lin_w[i_w] = str_c[i_w];
}
u3z(val);
return len;
}
/* _term_it_put_tint(): put ansi color id on lin_w. RETAINS col.
*/
static void
_term_it_put_tint(c3_w* lin_w,
static c3_w
_term_it_put_tint(c3_w* lin_w,
u3_noun col)
{
switch ( col ) {
default:
case u3_nul: *lin_w = '9'; break;
case 'k': *lin_w = '0'; break;
case 'r': *lin_w = '1'; break;
case 'g': *lin_w = '2'; break;
case 'y': *lin_w = '3'; break;
case 'b': *lin_w = '4'; break;
case 'm': *lin_w = '5'; break;
case 'c': *lin_w = '6'; break;
case 'w': *lin_w = '7'; break;
u3_noun red, gre, blu;
c3_o tru = u3r_trel(col, &red, &gre, &blu);
// 24-bit color
//
if ( c3y == tru ) {
c3_w n = 0;
*lin_w++ = '8';
*lin_w++ = ';';
*lin_w++ = '2';
*lin_w++ = ';';
c3_w m = _term_it_put_value(lin_w, red);
n += m;
lin_w += m;
*lin_w++ = ';';
m = _term_it_put_value(lin_w, gre);
n += m;
lin_w += m;
*lin_w++ = ';';
n += _term_it_put_value(lin_w, blu);
return n + 6;
}
// standard color
//
else {
switch ( col ) {
default:
case u3_nul: *lin_w = '9'; break;
case 'k': *lin_w = '0'; break;
case 'r': *lin_w = '1'; break;
case 'g': *lin_w = '2'; break;
case 'y': *lin_w = '3'; break;
case 'b': *lin_w = '4'; break;
case 'm': *lin_w = '5'; break;
case 'c': *lin_w = '6'; break;
case 'w': *lin_w = '7'; break;
}
return 1;
}
}
@ -1185,11 +1234,11 @@ _term_it_show_stub(u3_utty* uty_u,
// allocate enough memory for every display character, plus styles
//
//NOTE we use max 20 characters per styl for escape codes:
// 3 for opening, 4 for decorations, 4 for colors, 4 for closing,
//NOTE we use max 31 characters per styl for escape codes:
// 3 for opening, 4 for decorations, 15 for colors, 4 for closing,
// and 5 as separators between decorations and colors.
//
c3_w* lin_w = c3_malloc( sizeof(c3_w) * (lec_w + (20 * tuc_w)) );
c3_w* lin_w = c3_malloc( sizeof(c3_w) * (lec_w + (31 * tuc_w)) );
// write the contents to the buffer,
// tracking total and escape characters written
@ -1243,8 +1292,9 @@ _term_it_show_stub(u3_utty* uty_u,
sap_w++;
}
lin_w[i_w++] = '4';
_term_it_put_tint(&lin_w[i_w++], bag);
sap_w += 2;
c3_w put_w = _term_it_put_tint(&lin_w[i_w], bag);
i_w += put_w;
sap_w += ++put_w;
mor_o = c3y;
}
@ -1256,8 +1306,9 @@ _term_it_show_stub(u3_utty* uty_u,
sap_w++;
}
lin_w[i_w++] = '3';
_term_it_put_tint(&lin_w[i_w++], fog);
sap_w += 2;
c3_w put_w = _term_it_put_tint(&lin_w[i_w], fog);
i_w += put_w;
sap_w += ++put_w;
mor_o = c3y;
}