mirror of
https://github.com/urbit/shrub.git
synced 2024-12-02 08:55:07 +03:00
Merge remote-tracking branches 'ray/murmur3-hoon', 'ray/full-crub', 'dhaffey/electroll', 'joemfb/talk-foreign', 'joemfb/key-val', 'joemfb/gaf-by', 'dhaffey/peg-zero', 'joemfb/head-tail-electro', 'ohaitch/gall-boot-fixes', 'ohaitch/eyre-no-double-spacing', 'dhaffey/burn-zeroing' and 'philipcmonk/less-clay-sugar'
Correct Murmur3 hash implementation Fully implemented AES and crub in zuse Electroplate faces off ++roll etc. Reject foreign pokes in talk Arms to retrieve keys and values from maps Add gas:by variant that rejects collisions Fix ++peg axis 0 behavior Electroplate faces off ++head/++tail Improve type validation in gall Don't double-space eyre stack traces Fix improper ^~ zeroing of values Fix clay bug caused by above fix
This commit is contained in:
parent
daf33b94bc
37de0c8ad8
84d1ee87cc
9f82c20647
e6f814683d
9ab8241e78
d2acbc2d04
cc470a3023
7d7d70655b
82df022181
46453684fb
fb670851e1
e482fc81be
commit
c24c77bc16
@ -1101,10 +1101,8 @@
|
||||
he-abet:(he-arm +<)
|
||||
::
|
||||
++ peer-sole
|
||||
~? !=(src.hid our.hid) [%dojo-peer-stranger ost.hid src.hid]
|
||||
?> ?| =(src.hid our.hid)
|
||||
&(=(%earl (clan src.hid)) =(our.hid (sein src.hid)))
|
||||
==
|
||||
~? !=(our.hid src.hid) [%dojo-peer-stranger ost.hid src.hid]
|
||||
?> (team our.hid src.hid)
|
||||
=^ moz .
|
||||
?. (~(has by hoc) ost.hid) [~ .]
|
||||
~& [%dojo-peer-replaced ost.hid]
|
||||
|
@ -959,7 +959,7 @@
|
||||
::
|
||||
++ glyph
|
||||
|= idx/@
|
||||
=< cha.ole
|
||||
=< cha
|
||||
%+ reel glyphs
|
||||
|= {all/tape ole/{cha/char num/@}}
|
||||
=+ new=(snag (mod idx (lent all)) all)
|
||||
@ -2205,6 +2205,7 @@
|
||||
|= cod/command
|
||||
^+ [*(list move) +>]
|
||||
:: ~& [%talk-poke-command src.hid cod]
|
||||
?> (team our.hid src.hid)
|
||||
=^ mos +>.$
|
||||
ra-abet:(ra-apply:ra src.hid cod)
|
||||
=^ mow +>.$ log-all-to-file
|
||||
|
@ -125,7 +125,7 @@
|
||||
++ gas
|
||||
|= b/(list {k/key n/val})
|
||||
^+ a
|
||||
q:(roll b |=({{k/key n/val} q/_a} (put(a q) k n)))
|
||||
(roll b |=({{k/key n/val} q/_a} (put(a q) k n)))
|
||||
::
|
||||
++ tap
|
||||
^- (list {k/key n/val})
|
||||
|
@ -232,7 +232,7 @@
|
||||
^- (unit (unit (each cage lobe)))
|
||||
=+ ezy=?~(ref ~ (~(get by haw.u.ref) mun))
|
||||
?^ ezy
|
||||
`(bind u.ezy (cury same %&))
|
||||
`(bind u.ezy |=(a/cage [%& a]))
|
||||
=+ nao=(case-to-aeon:ze q.mun)
|
||||
:: ~& [%aver-mun nao [%from syd lim q.mun]]
|
||||
?~(nao ~ (read-at-aeon:ze u.nao mun))
|
||||
@ -1677,7 +1677,7 @@
|
||||
:- ~
|
||||
%+ bind
|
||||
fil.ank:(descend-path:(zu ank.dom) pax)
|
||||
(corl (cury same %&) tail)
|
||||
|=(a/{p/lobe q/cage} [%& q.a])
|
||||
=+ yak=(tako-to-yaki u.tak)
|
||||
=+ lob=(~(get by q.yak) pax)
|
||||
?~ lob
|
||||
@ -1765,7 +1765,7 @@
|
||||
?: ?=($u p.mun)
|
||||
(read-u yon r.mun)
|
||||
?: ?=($v p.mun)
|
||||
(bind (read-v yon r.mun) (curr bind (cury same %&)))
|
||||
(bind (read-v yon r.mun) (lift |=(a/cage [%& a])))
|
||||
?: ?=($x p.mun)
|
||||
(read-x yon r.mun)
|
||||
?: ?=($y p.mun)
|
||||
@ -1778,16 +1778,16 @@
|
||||
:: hep=-
|
||||
:: ==
|
||||
:: -
|
||||
(bind (read-y yon r.mun) (curr bind (cury same %&)))
|
||||
(bind (read-y yon r.mun) (lift |=(a/cage [%& a])))
|
||||
?: ?=($z p.mun)
|
||||
(bind (read-z yon r.mun) (curr bind (cury same %&)))
|
||||
(bind (read-z yon r.mun) (lift |=(a/cage [%& a])))
|
||||
%+ bind
|
||||
(rewind yon)
|
||||
|= a/(unit _+>.$)
|
||||
^- (unit (each cage lobe))
|
||||
?~ a
|
||||
~
|
||||
`(unit (each cage lobe))`(bind (read:u.a mun) (cury same %&))
|
||||
`(unit (each cage lobe))`(bind (read:u.a mun) |=(a/cage [%& a]))
|
||||
::
|
||||
++ rewind :: rewind:ze
|
||||
|= yon/aeon :: rewind to aeon
|
||||
|
@ -205,7 +205,7 @@
|
||||
|= {wid/@u tan/tang}
|
||||
^- tape
|
||||
=+ rolt=|=(a/wall `tape`?~(a ~ :(weld i.a "\0a" $(a t.a))))
|
||||
(rolt (turn tan |=(a/tank (rolt (wash 0^wid a)))))
|
||||
(rolt (zing (turn tan |=(a/tank (wash 0^wid a)))))
|
||||
::
|
||||
::
|
||||
++ add-cookies
|
||||
|
@ -145,22 +145,16 @@
|
||||
++ mo-boom :: complete new boot
|
||||
|= {dap/dude byk/beak dep/@uvH gux/gage}
|
||||
^+ +>
|
||||
=. +> (mo-bold byk dap dep)
|
||||
?- -.gux
|
||||
$tabl ~|(%made-tabl !!)
|
||||
$|
|
||||
=. +> (mo-bold byk dap dep)
|
||||
=. +> (mo-give %onto %| p.gux)
|
||||
+>
|
||||
$| (mo-give %onto %| p.gux)
|
||||
$&
|
||||
?> ?=(@ p.p.gux)
|
||||
?. (mo-okay q.p.gux)
|
||||
(mo-give %onto %| [%leaf "{<dap>}: bogus core"]~)
|
||||
=. +> (mo-bold byk dap dep)
|
||||
=. +> (mo-born dap byk q.p.gux)
|
||||
=+ old=+>.$
|
||||
=+ wag=(ap-prop:(ap-abed:ap dap [%high [~ our]]) ~)
|
||||
?^ -.wag
|
||||
=. +>.$ old
|
||||
(mo-give %onto %| u.-.wag)
|
||||
=. +>.$ ap-abet:+.wag
|
||||
(mo-give:(mo-claw dap) %onto %& dap %boot now)
|
||||
@ -194,8 +188,7 @@
|
||||
?- -.gux
|
||||
$tabl ~|(%made-tabl !!)
|
||||
$| (mo-give %onto %| p.gux)
|
||||
$& ?> ?=(@ p.p.gux)
|
||||
ap-abet:(ap-peep:(ap-abed:ap dap [%high [~ our]]) q.p.gux)
|
||||
$& ap-abet:(ap-peep:(ap-abed:ap dap [%high [~ our]]) q.p.gux)
|
||||
==
|
||||
::
|
||||
++ mo-bold :: wait for dep
|
||||
@ -647,7 +640,7 @@
|
||||
((slog leaf+"peek find fail" >tyl< >mar< ~) [~ ~])
|
||||
=^ arm +>.$ (ap-farm q.u.cug)
|
||||
?: ?=($| -.arm) ((slog leaf+"peek farm fail" p.arm) [~ ~])
|
||||
=^ zem +>.$ (ap-slam q.u.cug p.arm !>([ren (slag p.u.cug tyl)]))
|
||||
=^ zem +>.$ (ap-slam q.u.cug p.arm !>((slag p.u.cug `path`[ren tyl])))
|
||||
?: ?=($| -.zem) ((slog leaf+"peek slam fail" p.zem) [~ ~])
|
||||
?+ q.p.zem ((slog leaf+"peek bad result" ~) [~ ~])
|
||||
$~ ~
|
||||
@ -1082,17 +1075,17 @@
|
||||
++ ap-prop :: install
|
||||
|= vux/(unit vase)
|
||||
^- {(unit tang) _+>}
|
||||
=+ old=+>.$(hav ?~(vux hav u.vux))
|
||||
?. (ap-fond %prep)
|
||||
?~ vux
|
||||
`+>.$
|
||||
=+ [new=p:(slot 13 hav) old=p:(slot 13 u.vux)]
|
||||
?. (~(nest ut p:(slot 13 hav)) %| p:(slot 13 u.vux))
|
||||
:_(+>.$ `(ap-suck "prep mismatch"))
|
||||
:_(old `(ap-suck "prep mismatch"))
|
||||
`+>.$(+13.q.hav +13.q.u.vux)
|
||||
=^ tur +>.$
|
||||
%+ ap-call %prep
|
||||
?~(vux !>(~) (slop !>(~) (slot 13 u.vux)))
|
||||
?~(tur `+>.$ :_(+>.$ `u.tur))
|
||||
?~(tur `+>.$ :_(old `u.tur))
|
||||
::
|
||||
++ ap-pule :: silent delete
|
||||
=+ wim=(~(get by sup.ged) ost)
|
||||
@ -1179,10 +1172,11 @@
|
||||
|= {cog/term gat/vase arg/vase}
|
||||
^- {(each vase tang) _+>}
|
||||
=+ ^= wyz %- mule |.
|
||||
?> (~(nest ut p:(slot 6 gat)) %& p.arg)
|
||||
(~(play wa vel) [%cell p.gat p.arg] [%open [%$ ~] [%$ 2] [%$ 3] ~])
|
||||
?: ?=($| -.wyz)
|
||||
%- =+ sam=(~(peek ut p.gat) %free 6)
|
||||
(slog >%ap-slam-mismatch< ~(duck ut p.arg) ~(duck ut sam) ~)
|
||||
(slog >%ap-slam-mismatch< ~(duck ut p.arg) ~(duck ut sam) p.wyz)
|
||||
:_(+>.$ [%| (ap-suck "call: {<cog>}: type mismatch")])
|
||||
:_ +>.$(vel +>.wyz)
|
||||
=+ ton=(mong [q.gat q.arg] ap-sled)
|
||||
|
143
arvo/hoon.hoon
143
arvo/hoon.hoon
@ -553,6 +553,7 @@
|
||||
++ peg :: tree connect
|
||||
~/ %peg
|
||||
|= {a/@ b/@}
|
||||
?< =(0 a)
|
||||
^- @
|
||||
?- b
|
||||
$1 a
|
||||
@ -737,7 +738,7 @@
|
||||
++ reel :: right fold
|
||||
~/ %reel
|
||||
|* {a/(list) b/_|=({* *} +<+)}
|
||||
|- ^+ +<+.b
|
||||
|- ^+ ,.+<+.b
|
||||
?~ a
|
||||
+<+.b
|
||||
(b i.a $(a t.a))
|
||||
@ -745,7 +746,7 @@
|
||||
++ roll :: left fold
|
||||
~/ %roll
|
||||
|* {a/(list) b/_|=({* *} +<+)}
|
||||
|- ^+ +<+.b
|
||||
|- ^+ ,.+<+.b
|
||||
?~ a
|
||||
+<+.b
|
||||
$(a t.a, b b(+<+ (b i.a +<+.b)))
|
||||
@ -1090,34 +1091,64 @@
|
||||
++ fnv |=(a/@ (end 5 1 (mul 16.777.619 a))) :: FNV scrambler
|
||||
::
|
||||
++ muk :: standard murmur3
|
||||
~/ %muk
|
||||
|= {syd/@ key/@}
|
||||
?> (lte (met 5 syd) 1)
|
||||
=+ ^= row
|
||||
|= {a/@ b/@}
|
||||
(con (end 5 1 (lsh 0 a b)) (rsh 0 (sub 32 a) b))
|
||||
=+ mow=|=({a/@ b/@} (end 5 1 (mul a b)))
|
||||
=+ len=(met 5 key)
|
||||
=- =. goc (mix goc len)
|
||||
=. goc (mix goc (rsh 4 1 goc))
|
||||
=. goc (mow goc 0x85eb.ca6b)
|
||||
=. goc (mix goc (rsh 0 13 goc))
|
||||
=. goc (mow goc 0xc2b2.ae35)
|
||||
(mix goc (rsh 4 1 goc))
|
||||
^= goc
|
||||
=+ [inx=0 goc=syd]
|
||||
|- ^- @
|
||||
?: =(inx len) goc
|
||||
=+ kop=(cut 5 [inx 1] key)
|
||||
=. kop (mow kop 0xcc9e.2d51)
|
||||
=. kop (row 15 kop)
|
||||
=. kop (mow kop 0x1b87.3593)
|
||||
=. goc (mix kop goc)
|
||||
=. goc (row 13 goc)
|
||||
=. goc (end 5 1 (add 0xe654.6b64 (mul 5 goc)))
|
||||
$(inx +(inx))
|
||||
::
|
||||
++ mum :: mug with murmur3
|
||||
~% %muk ..muk ~
|
||||
=+ ~(. fe 5)
|
||||
|= {syd/@ len/@ key/@}
|
||||
?> &((lte (met 5 syd) 1) (lte (met 0 len) 31))
|
||||
=/ pad (sub len (met 3 key))
|
||||
=/ data (weld (rip 3 key) (reap pad 0))
|
||||
=/ nblocks (div len 4) :: intentionally off-by-one
|
||||
=/ h1 syd
|
||||
=+ [c1=0xcc9e.2d51 c2=0x1b87.3593]
|
||||
=/ blocks (rip 5 key)
|
||||
=/ i nblocks
|
||||
=. h1 =/ hi h1 |-
|
||||
?: =(0 i) hi
|
||||
=/ k1 (snag (sub nblocks i) blocks) :: negative array index
|
||||
=. k1 (sit (mul k1 c1))
|
||||
=. k1 (rol 0 15 k1)
|
||||
=. k1 (sit (mul k1 c2))
|
||||
=. hi (mix hi k1)
|
||||
=. hi (rol 0 13 hi)
|
||||
=. hi (sum (sit (mul hi 5)) 0xe654.6b64)
|
||||
$(i (dec i))
|
||||
=/ tail (slag (mul 4 nblocks) data)
|
||||
=/ k1 0
|
||||
=/ 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)))
|
||||
=. 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)))
|
||||
=. k1 (mix k1 (snag 0 tail))
|
||||
=. k1 (sit (mul k1 c1))
|
||||
=. k1 (rol 0 15 k1)
|
||||
=. k1 (sit (mul k1 c2))
|
||||
(mix h1 k1)
|
||||
$1 =. k1 (mix k1 (snag 0 tail))
|
||||
=. k1 (sit (mul k1 c1))
|
||||
=. k1 (rol 0 15 k1)
|
||||
=. k1 (sit (mul k1 c2))
|
||||
(mix h1 k1)
|
||||
==
|
||||
=. h1 (mix h1 len)
|
||||
|^ (fmix32 h1)
|
||||
++ fmix32
|
||||
|= h/@
|
||||
=. h (mix h (rsh 0 16 h))
|
||||
=. h (sit (mul h 0x85eb.ca6b))
|
||||
=. h (mix h (rsh 0 13 h))
|
||||
=. h (sit (mul h 0xc2b2.ae35))
|
||||
=. h (mix h (rsh 0 16 h))
|
||||
h
|
||||
--
|
||||
::
|
||||
++ mum :: mug with murmur3
|
||||
~/ %mum
|
||||
|= a/*
|
||||
|^ (trim ?@(a a (mix $(a -.a) (mix 0x7fff.ffff $(a +.a)))))
|
||||
@ -1125,7 +1156,7 @@
|
||||
|= key/@
|
||||
=+ syd=0xcafe.babe
|
||||
|- ^- @
|
||||
=+ haz=(muk syd key)
|
||||
=+ haz=(muk syd (met 3 key) key)
|
||||
=+ ham=(mix (rsh 0 31 haz) (end 0 31 haz))
|
||||
?.(=(0 ham) ham $(syd +(syd)))
|
||||
--
|
||||
@ -2264,8 +2295,8 @@
|
||||
:: section 2cI, almost macros ::
|
||||
::
|
||||
++ same |*(* +<) :: identity
|
||||
++ head |*(^ +<-) :: get head
|
||||
++ tail |*(^ +<+) :: get head
|
||||
++ head |*(^ ,:+<-) :: get head
|
||||
++ tail |*(^ ,:+<+) :: get tail
|
||||
++ fore |*(a/mold |*(b/mold (pair a b))) :: pair before
|
||||
++ aftr |*(a/mold |*(b/mold (pair b a))) :: pair after
|
||||
++ test |=(^ =(+<- +<+)) :: equality
|
||||
@ -2695,6 +2726,16 @@
|
||||
a
|
||||
$(b t.b, a (put p.i.b q.i.b))
|
||||
::
|
||||
+- gaf :: concat, fail on dupe
|
||||
~/ %gaf
|
||||
|= b/(list _?>(?=(^ a) n.a))
|
||||
|- ^+ a
|
||||
?~ b
|
||||
a
|
||||
~| duplicate-key+p.i.b
|
||||
?< (has p.i.b)
|
||||
$(b t.b, a (put p.i.b q.i.b))
|
||||
::
|
||||
+- get :: grab value by key
|
||||
~/ %get
|
||||
|= b/*
|
||||
@ -2823,6 +2864,17 @@
|
||||
+- wyt :: depth of map
|
||||
|- ^- @
|
||||
?~(a 0 +((add $(a l.a) $(a r.a))))
|
||||
::
|
||||
+- key :: set of keys
|
||||
|- ^- (set _?>(?=(^ a) p.n.a))
|
||||
?~ a ~
|
||||
[n=p.n.a l=$(a l.a) r=$(a r.a)]
|
||||
::
|
||||
+- val :: list of vals
|
||||
=| b/(list _?>(?=(^ a) q.n.a))
|
||||
|- ^+ b
|
||||
?~ a b
|
||||
$(a r.a, b [q.n.a $(a l.a)])
|
||||
--
|
||||
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
|
||||
:: section 2dC, queues ::
|
||||
@ -4572,16 +4624,16 @@
|
||||
^- {@ @}
|
||||
:- r
|
||||
?~ (mod n 2)
|
||||
(~(sum fo 65.535) l (muk (snag n raku) r))
|
||||
(~(sum fo 65.536) l (muk (snag n raku) r))
|
||||
(~(sum fo 65.535) l (muk (snag n raku) 4 r))
|
||||
(~(sum fo 65.536) l (muk (snag n raku) 4 r))
|
||||
::
|
||||
++ rund :: reverse round
|
||||
|= {n/@ l/@ r/@}
|
||||
^- {@ @}
|
||||
:- r
|
||||
?~ (mod n 2)
|
||||
(~(dif fo 65.535) l (muk (snag n raku) r))
|
||||
(~(dif fo 65.536) l (muk (snag n raku) r))
|
||||
(~(dif fo 65.535) l (muk (snag n raku) 4 r))
|
||||
(~(dif fo 65.536) l (muk (snag n raku) 4 r))
|
||||
::
|
||||
++ raku
|
||||
^- (list @ux)
|
||||
@ -5628,7 +5680,7 @@
|
||||
~/ %shar
|
||||
|= {pub/@ sek/@}
|
||||
^- @ux
|
||||
=+ exp=(shal (rsh 0 3 b) 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)
|
||||
@ -7933,11 +7985,9 @@
|
||||
|%
|
||||
++ burn
|
||||
=+ gil=*(set span)
|
||||
~| %burn
|
||||
%- need
|
||||
|- ^- (unit)
|
||||
?- sut
|
||||
{$atom *} `?~(q.sut 0 u.q.sut)
|
||||
{$atom *} q.sut
|
||||
{$cell *} %+ biff $(sut p.sut)
|
||||
|=(* (biff ^$(sut q.sut) |=(* `[+>+< +<])))
|
||||
{$core *} (biff $(sut p.sut) |=(* `[p.r.q.sut +<]))
|
||||
@ -7954,7 +8004,7 @@
|
||||
{$hold *} ?: (~(has in gil) sut)
|
||||
~
|
||||
$(sut repo, gil (~(put in gil) sut))
|
||||
$noun `0
|
||||
$noun ~
|
||||
$void ~
|
||||
==
|
||||
::
|
||||
@ -8688,8 +8738,11 @@
|
||||
{$zinc *} =+(vat=$(gen p.gen) [(wrap(sut p.vat) %zinc) q.vat])
|
||||
{$burn *}
|
||||
=+ nef=$(gen p.gen)
|
||||
=+ moc=(mink [burn q.nef] |=({* *} ~))
|
||||
[p.nef ?:(?=($0 -.moc) [%1 p.moc] q.nef)]
|
||||
:- p.nef
|
||||
=+ cag=burn
|
||||
?~ cag q.nef
|
||||
=+ moc=(mink [u.cag q.nef] |=({* *} ~))
|
||||
?:(?=($0 -.moc) [%1 p.moc] q.nef)
|
||||
::
|
||||
{$name *} =+(vat=$(gen q.gen) [(conk(sut p.vat) p.gen) q.vat])
|
||||
{$lead *} =+(vat=$(gen p.gen) [(wrap(sut p.vat) %lead) q.vat])
|
||||
@ -9480,7 +9533,7 @@
|
||||
=- [a (welp - ?~(c d [[[%rock %tas p.c] q.c] d]))]
|
||||
=- (~(tap by -))
|
||||
%. |=(e/(list tank) [%knit ~(ram re %rose [" " `~] e)])
|
||||
=< ~(run by f:(reel b .))
|
||||
=< ~(run by (reel b .))
|
||||
|= {e/{p/term q/term} f/(jar twig tank)}
|
||||
(~(add ja f) [%rock %tas p.e] [%leaf (trip q.e)])
|
||||
;~ plug
|
||||
|
217
arvo/zuse.hoon
217
arvo/zuse.hoon
@ -430,24 +430,21 @@
|
||||
|_ {key/@H mod/bloq ctr/@H}
|
||||
++ en
|
||||
~/ %en
|
||||
|= txt/@ ^- @ux
|
||||
=+ pts=?:(=(txt 0) `(list @)`~[0] (flop (rip 3 txt)))
|
||||
=| cts/(list @)
|
||||
=+ str=(flop (rip 3 (~(en ecba key) ctr)))
|
||||
%+ rep 3
|
||||
:: logically, flop twice here
|
||||
|- ^- (list @)
|
||||
?~ pts
|
||||
cts
|
||||
?~ str
|
||||
=+ nctr=(inc mod ctr)
|
||||
$(str (flop (rip 3 (~(en ecba key) nctr))), ctr nctr)
|
||||
%= $
|
||||
cts :_ cts
|
||||
(mix i.str i.pts)
|
||||
str t.str
|
||||
pts t.pts
|
||||
==
|
||||
|= txt/@
|
||||
^- @ux
|
||||
=/ encrypt ~(en ecba key)
|
||||
=/ blocks (met 7 txt)
|
||||
=. blocks ?:(=(0 blocks) 1 blocks)
|
||||
=/ bytes (met 3 txt)
|
||||
=. bytes ?:(=(0 bytes) 1 bytes)
|
||||
%+ mix txt
|
||||
%^ rsh 3 (sub (mul 16 blocks) bytes)
|
||||
%+ rep 7
|
||||
%- flop :: stupid backwards AES
|
||||
|- ^- (list @ux)
|
||||
?: =(blocks 0) ~
|
||||
:- (encrypt ctr)
|
||||
$(ctr (inc mod ctr), blocks (dec blocks))
|
||||
++ de en
|
||||
--
|
||||
::
|
||||
@ -456,24 +453,21 @@
|
||||
|_ {key/@I mod/bloq ctr/@H}
|
||||
++ en
|
||||
~/ %en
|
||||
|= txt/@ ^- @ux
|
||||
=+ pts=?:(=(txt 0) `(list @)`~[0] (flop (rip 3 txt)))
|
||||
=| cts/(list @)
|
||||
=+ str=(flop (rip 3 (~(en ecbb key) ctr)))
|
||||
%+ rep 3
|
||||
:: logically, flop twice here
|
||||
|- ^- (list @)
|
||||
?~ pts
|
||||
cts
|
||||
?~ str
|
||||
=+ nctr=(inc mod ctr)
|
||||
$(str (flop (rip 3 (~(en ecbb key) nctr))), ctr nctr)
|
||||
%= $
|
||||
cts :_ cts
|
||||
(mix i.str i.pts)
|
||||
str t.str
|
||||
pts t.pts
|
||||
==
|
||||
|= txt/@
|
||||
^- @ux
|
||||
=/ encrypt ~(en ecbb key)
|
||||
=/ blocks (met 7 txt)
|
||||
=. blocks ?:(=(0 blocks) 1 blocks)
|
||||
=/ bytes (met 3 txt)
|
||||
=. bytes ?:(=(0 bytes) 1 bytes)
|
||||
%+ mix txt
|
||||
%^ rsh 3 (sub (mul 16 blocks) bytes)
|
||||
%+ rep 7
|
||||
%- flop :: stupid backwards AES
|
||||
|- ^- (list @ux)
|
||||
?: =(blocks 0) ~
|
||||
:- (encrypt ctr)
|
||||
$(ctr (inc mod ctr), blocks (dec blocks))
|
||||
++ de en
|
||||
--
|
||||
::
|
||||
@ -482,24 +476,21 @@
|
||||
|_ {key/@I mod/bloq ctr/@H}
|
||||
++ en
|
||||
~/ %en
|
||||
|= txt/@ ^- @ux
|
||||
=+ pts=?:(=(txt 0) `(list @)`~[0] (flop (rip 3 txt)))
|
||||
=| cts/(list @)
|
||||
=+ str=(flop (rip 3 (~(en ecbc key) ctr)))
|
||||
%+ rep 3
|
||||
:: logically, flop twice here
|
||||
|- ^- (list @)
|
||||
?~ pts
|
||||
cts
|
||||
?~ str
|
||||
=+ nctr=(inc mod ctr)
|
||||
$(str (flop (rip 3 (~(en ecbc key) nctr))), ctr nctr)
|
||||
%= $
|
||||
cts :_ cts
|
||||
(mix i.str i.pts)
|
||||
str t.str
|
||||
pts t.pts
|
||||
==
|
||||
|= txt/@
|
||||
^- @ux
|
||||
=/ encrypt ~(en ecbc key)
|
||||
=/ blocks (met 7 txt)
|
||||
=. blocks ?:(=(0 blocks) 1 blocks)
|
||||
=/ bytes (met 3 txt)
|
||||
=. bytes ?:(=(0 bytes) 1 bytes)
|
||||
%+ mix txt
|
||||
%^ rsh 3 (sub (mul 16 blocks) bytes)
|
||||
%+ rep 7
|
||||
%- flop :: stupid backwards AES
|
||||
|- ^- (list @ux)
|
||||
?: =(blocks 0) ~
|
||||
:- (encrypt ctr)
|
||||
$(ctr (inc mod ctr), blocks (dec blocks))
|
||||
++ de en
|
||||
--
|
||||
::
|
||||
@ -662,7 +653,7 @@
|
||||
++ en
|
||||
~/ %en
|
||||
|= txt/@
|
||||
^- {@uxH @ux}
|
||||
^- (pair @uxH @ux)
|
||||
=+ [k1=(rsh 7 1 key) k2=(end 7 1 key)]
|
||||
=+ iv=(s2va k1 (weld vec (limo ~[txt])))
|
||||
:-
|
||||
@ -686,7 +677,7 @@
|
||||
++ en
|
||||
~/ %en
|
||||
|= txt/@
|
||||
^- {@uxH @ux}
|
||||
^- (pair @uxH @ux)
|
||||
=+ [k1=(rsh 5 3 key) k2=(end 5 3 key)]
|
||||
=+ iv=(s2vb k1 (weld vec (limo ~[txt])))
|
||||
:-
|
||||
@ -710,7 +701,7 @@
|
||||
++ en
|
||||
~/ %en
|
||||
|= txt/@
|
||||
^- {@uxH @ux}
|
||||
^- (pair @uxH @ux)
|
||||
=+ [k1=(rsh 8 1 key) k2=(end 8 1 key)]
|
||||
=+ iv=(s2vc k1 (weld vec (limo ~[txt])))
|
||||
:-
|
||||
@ -927,49 +918,51 @@
|
||||
++ as
|
||||
|%
|
||||
++ sign
|
||||
|= {nonc/@ msg/@}
|
||||
|= {@ msg/@}
|
||||
^- @ux
|
||||
?~ sek ~| %pubkey-only !!
|
||||
=+ nms=(jam [nonc msg])
|
||||
(jam [(sign:ed nms sgn.u.sek) nms])
|
||||
(jam [(sign:ed msg sgn.u.sek) msg])
|
||||
++ sure
|
||||
|= {nonc/@ txt/@}
|
||||
|= {@ txt/@}
|
||||
^- (unit @ux)
|
||||
=+ ((hard {sig/@ nms/@}) (cue txt))
|
||||
?. (veri:ed sig nms sgn.pub) ~
|
||||
=+ ((hard {n/@ msg/@}) (cue nms))
|
||||
?. =(nonc n) ~
|
||||
=+ ((hard {sig/@ msg/@}) (cue txt))
|
||||
?. (veri:ed sig msg sgn.pub) ~
|
||||
(some msg)
|
||||
++ seal
|
||||
|= {bpk/pass nonc/@ msg/@}
|
||||
|= {bpk/pass m1/@ m2/@}
|
||||
^- @ux
|
||||
?~ sek ~| %pubkey-only !!
|
||||
?> =('b' (end 3 1 bpk))
|
||||
=+ pk=(rsh 8 1 (rsh 3 1 bpk))
|
||||
=+ shar=(shax (shar:ed pk cry.u.sek))
|
||||
(jam [nonc (~(en siva:aes shar ~[nonc]) msg)])
|
||||
=+ msg=(jam m1 m2)
|
||||
=+ smsg=(sign ~ msg)
|
||||
(jam (~(en siva:aes shar ~) smsg))
|
||||
++ tear
|
||||
|= {bpk/pass txt/@}
|
||||
^- (unit {@ux @ux})
|
||||
^- (unit (pair @ux @ux))
|
||||
?~ sek ~| %pubkey-only !!
|
||||
?> =('b' (end 3 1 bpk))
|
||||
=+ pk=(rsh 8 1 (rsh 3 1 bpk))
|
||||
=+ shar=(shax (shar:ed pk cry.u.sek))
|
||||
=+ ((hard {nonc/@ iv/@ cph/@}) (cue txt))
|
||||
%+ both (some nonc)
|
||||
(~(de siva:aes shar ~[nonc]) iv cph)
|
||||
=+ ((hard {iv/@ cph/@}) (cue txt))
|
||||
=+ try=(~(de siva:aes shar ~) iv cph)
|
||||
?~ try ~
|
||||
=+ veri=(sure:as:(com:nu:crub bpk) ~ u.try)
|
||||
?~ veri ~
|
||||
(some ((hard (pair @ux @ux)) (cue u.veri)))
|
||||
--
|
||||
++ de
|
||||
|= {key/@I cph/@}
|
||||
|= {key/@J cph/@}
|
||||
^- (unit @ux)
|
||||
%+ ~(de siva:aes key ~)
|
||||
%+ ~(de sivc:aes (shaz key) ~)
|
||||
(end 7 1 cph)
|
||||
(rsh 7 1 cph)
|
||||
++ dy |=({key/@I cph/@} (need (de key cph)))
|
||||
++ en
|
||||
|= {key/@I msg/@}
|
||||
|= {key/@J msg/@}
|
||||
^- @ux
|
||||
(cat 7 (~(en siva:aes key ~) msg))
|
||||
(cat 7 (~(en sivc:aes (shaz key) ~) msg))
|
||||
++ ex
|
||||
|%
|
||||
++ fig ^- @uvH (shaf %bfig sgn.^pub)
|
||||
@ -983,53 +976,45 @@
|
||||
|%
|
||||
++ pit
|
||||
|= {w/@ seed/@}
|
||||
=+ bits=(shaz seed) :: need 512 bits
|
||||
=+ [c=(rsh 8 1 seed) s=(end 8 1 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)]
|
||||
..nu(pub [cry=(puck:ed c) sgn=(puck:ed s)], sek `[cry=c sgn=s])
|
||||
++ nol
|
||||
|= a/ring
|
||||
=+ [c=(rsh 8 1 a) s=(end 8 1 a)]
|
||||
=+ [mag=(end 3 1 a) bod=(rsh 3 1 a)]
|
||||
~| %not-crub-seckey ?> =('B' mag)
|
||||
=+ [c=(rsh 8 1 bod) s=(end 8 1 bod)]
|
||||
..nu(pub [cry=(puck:ed c) sgn=(puck:ed s)], sek `[cry=c sgn=s])
|
||||
++ com
|
||||
|= a/pass
|
||||
..nu(pub [cry=(rsh 8 1 a) sgn=(end 8 1 a)], sek ~)
|
||||
=+ [mag=(end 3 1 a) bod=(rsh 3 1 a)]
|
||||
~| %not-crub-pubkey ?> =('b' mag)
|
||||
..nu(pub [cry=(rsh 8 1 bod) sgn=(end 8 1 bod)], sek ~)
|
||||
--
|
||||
--
|
||||
::
|
||||
++ brew :: create keypair
|
||||
|= {a/@ b/@} :: width seed
|
||||
^- acru
|
||||
(pit:nu:crub a b)
|
||||
::
|
||||
++ hail :: activate public key
|
||||
|= a/pass
|
||||
^- acru
|
||||
=+ [mag=(end 3 1 a) bod=(rsh 3 1 a)]
|
||||
?> =('b' mag)
|
||||
(com:nu:crub bod)
|
||||
::
|
||||
++ wear :: activate secret key
|
||||
|= a/ring
|
||||
^- acru
|
||||
=+ [mag=(end 3 1 a) bod=(rsh 3 1 a)]
|
||||
?> =('B' mag)
|
||||
(nol:nu:crub bod)
|
||||
::
|
||||
++ trub :: test ed
|
||||
|= msg/@tas
|
||||
^- @
|
||||
=+ ali=(brew 1.024 (cat 8 (shax 'ali') (shad 'ali')))
|
||||
=+ bob=(brew 1.024 (cat 8 (shax 'bob') (shad 'bob')))
|
||||
=+ tef=(sign:as.ali [0 msg])
|
||||
=+ lov=(sure:as.ali [0 tef])
|
||||
?. &(?=(^ lov) =(msg u.lov))
|
||||
~|(%test-fail-sign !!)
|
||||
=+ key=(shax (shax (shax msg)))
|
||||
=+ sax=(seal:as.ali pub:ex.bob key msg)
|
||||
=+ tin=(tear:as.bob pub:ex.ali sax)
|
||||
?. &(?=(^ tin) =(key p.u.tin) =(msg q.u.tin))
|
||||
~|(%test-fail-seal !!)
|
||||
msg
|
||||
++ trub :: test crub
|
||||
|= msg/@t
|
||||
:: make acru cores
|
||||
=/ ali (pit:nu:crub 512 (shaz 'Alice'))
|
||||
=/ ali-pub (com:nu:crub pub:ex.ali)
|
||||
=/ bob (pit:nu:crub 512 (shaz 'Robert'))
|
||||
=/ bob-pub (com:nu:crub pub:ex.bob)
|
||||
:: alice signs and encrypts a symmetric key to bob
|
||||
=/ secret-key %- shaz
|
||||
'Let there be no duplicity when taking a stand against him.'
|
||||
=/ signed-key (sign:as.ali ~ secret-key)
|
||||
=/ crypted-key (seal:as.ali pub:ex.bob-pub ~ signed-key)
|
||||
:: bob decrypts and verifies
|
||||
=/ decrypt-key-attempt (tear:as.bob pub:ex.ali-pub crypted-key)
|
||||
=/ decrypted-key ~| %decrypt-fail (need decrypt-key-attempt)
|
||||
=/ verify-key-attempt (sure:as.ali-pub ~ q.decrypted-key)
|
||||
=/ verified-key ~| %verify-fail (need verify-key-attempt)
|
||||
:: bob encrypts with symmetric key
|
||||
=/ crypted-msg (en.bob verified-key msg)
|
||||
:: alice decrypts with same key
|
||||
`@t`(dy.ali secret-key crypted-msg)
|
||||
::
|
||||
++ hmac :: HMAC-SHA1
|
||||
|= {key/@ mes/@}
|
||||
@ -2180,6 +2165,12 @@
|
||||
$earl (end 5 1 who)
|
||||
$pawn `@p`0
|
||||
==
|
||||
::
|
||||
++ team :: our / our moon
|
||||
|= {our/@p him/@p}
|
||||
?| =(our him)
|
||||
&(?=($earl (clan him)) =(our (sein him)))
|
||||
==
|
||||
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
|
||||
:: section 3bI, Arvo structures ::
|
||||
::
|
||||
|
Loading…
Reference in New Issue
Block a user