/= ztd-two /common/ztd/two => ztd-two ~% %misc-lib ..lift ~ :: misc-lib |% :: +flec: reflect a noun, i.e. switch head and tail ++ flec |* * ?@ +< +< +<+^+<- :: ++ lib-u32 ~% %lib-u32 + ~ :: Unsigned 32-bit Arithmetic |% +$ u32 @udthirtytwo ++ bex32 ^~((bex 32)) :: 4.294.967.296 ++ max32 ^~((dec (bex 32))) :: 4.294.967.295 :: :: +is-u32: is atom a u32? ++ is-u32 ~/ %is-u32 |= a=@ ^- ? (lth a bex32) :: :: +belt-to-u32: decompose a belt to u32s ++ belt-to-u32s ~/ %btu32s |= sam=belt ^- [lo=u32 hi=u32] ?> (lth sam p) ::NOTE: in flib and jutes, this is bex64 instead of goldilocks prime? :: ?> (lth sam (bex 64)) (flec (dvr sam bex32)) :: ++ belt-from-u32s ~/ %bfu32s |= [lo=u32 hi=u32] ^- belt ?> ?&((is-u32 lo) (is-u32 hi)) (add lo (mul bex32 hi)) :: :: +u32-add: a + b = lo + (2^32)*car ++ u32-add |= [a=u32 b=u32] ^- [lo=u32 car=u32] ?> ?&((is-u32 a) (is-u32 b)) (flec (dvr (badd a b) (bex 32))) :: :: +u32-sub: a - b = -(2^32)*bor + com :: :: If a>b, then a-b=c is interpreable as an ordinary u32. But if a ?&((is-u32 a) (is-u32 b)) [(~(dif fo (bex 32)) a b) ?:((lth a b) 1 0)] :: :: +u32-lth: [a b] --> 0/1 according to a < b T/F ++ u32-lth ~/ %u32-lth |= [a=u32 b=u32] ^- ? ?> ?&((is-u32 a) (is-u32 b)) (lth a b) :: :: +u32-mul: a*b = lo + (2^32)*hi ++ u32-mul ~/ %u32-mul |= [a=u32 b=u32] ^- [lo=u32 hi=u32] ?> ?&((is-u32 a) (is-u32 b)) (flec (dvr (bmul a b) bex32)) :: :: +u32-dvr: a = qot*b + rem, rem < b ++ u32-dvr ~/ %u32-dvr |= [a=u32 b=u32] ^- [qot=u32 rem=u32] ?> ?&((is-u32 a) (is-u32 b)) (dvr a b) :: :: +u32-div: a / b = c such that a - b*c < b ++ u32-div ~/ %u32-div |= [a=u32 b=u32] ^- u32 ?> ?&((is-u32 a) (is-u32 b)) qot:(u32-dvr a b) :: :: +u32-mod: a - b*(a / b) ++ u32-mod ~/ %u32-mod |= [a=u32 b=u32] ^- u32 ?> ?&((is-u32 a) (is-u32 b)) rem:(u32-dvr a b) -- :: ++ bignum :: /lib/bignum ~% %bignum + ~ |% ++ l32 lib-u32 ++ u32 u32:l32 :: mirrors bignum from flib :: 32 bits = 2^5 bits => bloq size of 5 +$ bignum :: LSB order (based on result of rip) :: empty array is 0 [%bn p=(list u32)] :: :: +p: Goldilocks prime, written in bignum form :: :: least significant bit first, so: :: p = 2^64-2^32+1 = 2^32(2^32 - 1) + 1 ++ p ^- bignum [%bn ~[1 4.294.967.295]] :: :: +p2: p^2 ++ p2 ^- bignum [%bn ~[1 4.294.967.294 2 4.294.967.294]] :: :: +p3: p^3 ++ p3 ^- bignum [%bn ~[1 4.294.967.293 5 4.294.967.289 5 4.294.967.293]] :: ++ chunk ~/ %chunk |= a=@ ^- bignum [%bn (rip-correct 5 a)] :: ++ merge ~/ %merge |= b=bignum ^- @ :: fock always turns unchunked bignums into chunked case (rep 5 p.b) :: ++ valid :: are all elements of the list valid big int chunks, i.e., less than u32.max_val ~/ %valid |= b=bignum ^- ? (levy p.b |=(c=@ (lth c (bex 32)))) -- ::bignum :: ++ shape :: /lib/shape ~% %shape ..shape ~ =, mp-to-mega |% :: +dyck: produce the Dyck word describing the shape of a tree ++ dyck ~/ %dyck |= t=* %- flop ^- (list @) =| vec=(list @) |- ?@ t vec $(t +.t, vec [1 $(t -.t, vec [0 vec])]) :: :: +grow: grow the tree with given shape and leaves ++ grow ~/ %grow |= [shape=(list @) leaves=(list @)] ^- * ?> ?&(=((lent shape) (mul 2 (dec (lent leaves)))) (valid-shape shape)) ?~ shape ?> ?=([@ ~] leaves) i.leaves =/ lr-shape (left-right-shape shape) =/ split-idx (shape-size -:lr-shape) =/ split-leaves (split split-idx leaves) :- (grow -:lr-shape -:split-leaves) (grow +:lr-shape +:split-leaves) :: :: +shape-size: size of the tree in #leaves described by a given Dyck word ++ shape-size ~/ %shape-size |= shape=(list @) ^- @ (add 1 (div (lent shape) 2)) :: ++ leaf-sequence ~/ %leaf-sequence |= t=* %- flop ^- (list @) =| vec=(list @) |- ?@ t t^vec $(t +.t, vec $(t -.t)) :: ++ num-of-leaves ~/ %num-of-leaves |= t=* ?@ t 1 %+ add (num-of-leaves -:t) (num-of-leaves +:t) :: :: +left-right-shape: extract left and right tree shapes from given tree shape ++ left-right-shape ~/ %left-right-shape |= shape=(list @) ^- [(list @) (list @)] ?> (valid-shape shape) ?: =((lent shape) 0) ~| "Empty tree has no left subtree." !! =. shape (slag 1 shape) =/ stack-height 1 =| lefsh=(list @) |- ?: =(stack-height 0) ?< ?=(~ lefsh) [(flop t.lefsh) shape] ?< ?=(~ shape) ?: =(i.shape 0) $(lefsh [i.shape lefsh], shape t.shape, stack-height +(stack-height)) $(lefsh [i.shape lefsh], shape t.shape, stack-height (dec stack-height)) :: ++ axis-to-axes ~/ %axis-to-axes |= axi=@ ^- (list @) =| lis=(list @) |- ?: =(1 axi) lis =/ hav (dvr axi 2) $(axi p.hav, lis [?:(=(q.hav 0) 2 3) lis]) :: :: +valid-shape: computes whether a given vector is a valid tree shape ++ valid-shape ~/ %valid-shape |= shape=(list @) ^- ? =/ stack-height 0 |- ?: ?=(~ shape) ?: =(stack-height 0) %.y %.n ?> ?|(=(i.shape 0) =(i.shape 1)) ?: =(i.shape 0) $(shape t.shape, stack-height +(stack-height)) ?: =(stack-height 0) %.n $(shape t.shape, stack-height (dec stack-height)) :: :: +split: split ~[a_1 ... a_n] into [~[a)1 ... a_{idx -1}] ~[a_{idx} ... a_n]] ++ split ~/ %split |= [idx=@ lis=(list @)] ^- [(list @) (list @)] ~| "Index argument must be less than list length." ?> (lth idx (lent lis)) =| lef=(list @) =/ i 0 |- ?: =(i idx) [(flop lef) lis] ?< ?=(~ lis) $(lef [i.lis lef], lis t.lis, i +(i)) :: ++ shape-axis-to-index ~/ %shape-axis-to-index |= [tre=* axis=@] ^- [dyck-index=@ leaf-index=@] =/ axes (axis-to-axes axis) =/ shape (dyck tre) =/ dyck-index 0 =/ leaf-index 0 |- ?~ axes [dyck-index leaf-index] =/ lr-shape (left-right-shape shape) ?: =(i.axes 2) $(axes t.axes, shape -.lr-shape) ?> =(i.axes 3) %_ $ axes t.axes shape +.lr-shape dyck-index (add dyck-index (lent -.lr-shape)) leaf-index (add leaf-index (shape-size -.lr-shape)) == :: :: +path-to-axis: binary directions to input axis ++ path-to-axis |= axis=belt ^- (list belt) (slag 1 (flop (rip 0 axis))) :: :: +ion-eval: eval first arg as poly at alpha :: :: First arg is a polynomial, read high powers to low from L to R. :: In practice this poly is a dyck word or leaf vector. ++ ion-eval |= [word-vec=(list belt) alpha=belt] ^- belt %+ roll word-vec |= [coeff=_f0 acc=_f0] ^- belt (badd (bmul alpha acc) coeff) :: ++ ion-eval-symbolic |= [word-vec=(list mp-mega) alpha=mp-mega] ^- mp-mega %+ roll word-vec |= [coeff=mp-mega acc=mp-mega] ^- mp-mega (mpadd (mpmul alpha acc) coeff) -- ::shape :: ++ tip5 :: lib/tip5 ~% %tip5-lib ..tip5 ~ |% +| %user-types +$ noun-digest [belt belt belt belt belt] +$ ten-cell [noun-digest noun-digest] :: ++ digest-dyck-word ^- (list @) ~[0 1 0 1 0 1 0 1] ++ ten-cell-dyck-word ^~ ^- (list @) (weld [0 digest-dyck-word] [1 digest-dyck-word]) :: :: a sponge-tuple is a 16-tuple of belts; relevant for hash5.hoon ++ sponge-tuple-dyck-word ^~ ^- (list @) (zing (reap (dec state-size) ~[0 1])) :: +| %user-funcs :: :: +hash-ten-cell ++ hash-ten-cell ~/ %hash-ten-cell |= =ten-cell ^- noun-digest =- ?> ?=(noun-digest -) - %- list-to-tuple %- hash-10 %- leaf-sequence:shape ten-cell :: :: +hash-leaf ++ hash-leaf |= leaf=belt ^- noun-digest :: ?> (based leaf) commented out because its performed in +hash-varlen (hash-belts-list ~[leaf]) :: :: $hashable: a DSL for hashing anything +$ hashable $~ [%leaf p=*] $^ [p=hashable q=hashable] $% [%leaf p=*] [%hash p=noun-digest] [%list p=(list hashable)] [%mary p=mary] == :: :: +hash-hashable ++ hash-hashable ~/ %hash-hashable |= h=hashable ^- noun-digest ?: ?=(%hash -.h) p.h ?: ?=(%leaf -.h) (hash-noun-varlen p.h) ?: ?=(%list -.h) (hash-noun-varlen (turn p.h hash-hashable)) ?: ?=(%mary -.h) %- hash-hashable :- leaf+step.p.h :- leaf+len.array.p.h hash+(hash-belts-list (bpoly-to-list array:(~(change-step ave p.h) 1))) %- hash-ten-cell [$(h p.h) $(h q.h)] :: ++ hashable-noun-digests |= lis=(list noun-digest) ^- hashable list+(turn lis |=(nd=noun-digest hash+nd)) :: ++ hashable-bpoly |= bp=bpoly ^- hashable mary+`mary`[%1 bp] :: ++ hashable-fpoly |= fp=fpoly ^- hashable mary+`mary`[%3 fp] :: ++ hashable-mary |= =mary ^- hashable mary+mary :: :: +hash-noun-varlen ++ hash-noun-varlen ~/ %hash-noun-varlen |= n=* ^- noun-digest =/ leaf=(list @) (leaf-sequence:shape n) =/ dyck=(list @) (dyck:shape n) =/ size (lent leaf) (hash-belts-list [size (weld leaf dyck)]) :: :: +hash-felt ++ hash-felt ~/ %hash-felt |= =felt ^- noun-digest:tip5 =/ felt-tuple=[@ @ @ @ @] ;; [@ @ @ @ @] %- list-to-tuple (weld (felt-to-list felt) ~[0 0]) (hash-ten-cell felt-tuple [0 0 0 0 0]) :: :: ++ hash-belts-list ~/ %hash-belts-list |= belts=(list belt) ^- noun-digest:tip5 =- ?> ?=(noun-digest -) - %- list-to-tuple (hash-varlen belts) :: :: +hash-pairs ++ hash-pairs ~/ %hash-pairs |= lis=(list (list @)) ^- (list (list @)) |^ %+ turn (indices (lent lis)) |= b=@ ?: =(+(b) (lent lis)) (snag b lis) (hash-10:tip5 (weld (snag b lis) (snag +(b) lis))) :: :: TODO: there is probably a more clean way to generate indices. ++ indices |= n=@ ^- (list @) ?< =(n 0) =/ i 0 |- ?: (gte i n) ~ [i $(i (add 2 i))] -- :: :: +snag-as-digest :: :: Retrieve the i-th entry of the mary return it as a tip5 hash digest. :: Assumes that each entry of the mary is a single hash encoded in base 64. :: ++ snag-as-digest ~/ %snag-as-digest |= [m=mary i=@] ^- noun-digest:tip5 ?> =(5 step.m) =/ buf (~(snag ave m) i) :* (cut 6 [0 1] buf) (cut 6 [1 1] buf) (cut 6 [2 1] buf) (cut 6 [3 1] buf) (cut 6 [4 1] buf) == :: :: +list-to-digest ++ list-to-digest ~/ %list-to-digest |= lis=(list @) ^- noun-digest:tip5 ?> =(5 (lent lis)) :* (snag 0 lis) (snag 1 lis) (snag 2 lis) (snag 3 lis) (snag 4 lis) == :: :: +atom-to-digest :: :: Converts hex buffer into base-p representation ++ atom-to-digest ~/ %atom-to-digest |= buffer=@ux ^- noun-digest:tip5 =/ [q=@ a=@] (dvr buffer p) =/ [q=@ b=@] (dvr q p) =/ [q=@ c=@] (dvr q p) =/ [e=@ d=@] (dvr q p) [a b c d e] :: :: +digest-to-atom :: :: Returns a hexadecimal representation of the hash. :: We treat the tip-5 hash as a base-p number. ++ digest-to-atom ~/ %digest-to-atom |= [a=belt b=belt c=belt d=belt e=belt] ^- @ux =/ p2 (mul p p) =/ p3 (mul p2 p) =/ p4 (mul p3 p) ;: add a (mul p b) (mul p2 c) (mul p3 d) (mul p4 e) == :: +| %dev-types +$ digest (list melt) :: length = digest-length +$ state (list melt) :: length = state-size +$ domain ?(%variable %fixed) +$ tip5-state (list melt) :: +| %dev-constants ++ digest-length 5 ++ state-size 16 ++ num-split-and-lookup 4 ++ capacity 6 ++ rate 10 ++ num-rounds 5 ++ max-tip5-atom (digest-to-atom [(dec p) (dec p) (dec p) (dec p) (dec p)]) :: ++ state-dyck-word ^~ ^- (list @) (zing (reap state-size ~[0 1])) :: :: +lookup-table: represents the map x -> (x+1)^3 - 1 (mod 257) on {0, ..., 255} :: :: Used on the first 4 state elements in the S-box layer of each round of Tip5 ++ lookup-table ^- (list @) :~ 0 7 26 63 124 215 85 254 214 228 45 185 140 173 33 240 29 177 176 32 8 110 87 202 204 99 150 106 230 14 235 128 213 239 212 138 23 130 208 6 44 71 93 116 146 189 251 81 199 97 38 28 73 179 95 84 152 48 35 119 49 88 242 3 148 169 72 120 62 161 166 83 175 191 137 19 100 129 112 55 221 102 218 61 151 237 68 164 17 147 46 234 203 216 22 141 65 57 123 12 244 54 219 231 96 77 180 154 5 253 133 165 98 195 205 134 245 30 9 188 59 142 186 197 181 144 92 31 224 163 111 74 58 69 113 196 67 246 225 10 121 50 60 157 90 122 2 250 101 75 178 159 24 36 201 11 243 132 198 190 114 233 39 52 21 209 108 238 91 187 18 104 194 37 153 34 200 143 126 155 236 118 64 80 172 89 94 193 135 183 86 107 252 13 167 206 136 220 207 103 171 160 76 182 227 217 158 56 174 4 66 109 139 162 184 211 249 47 125 232 117 43 16 42 127 20 241 25 149 105 156 51 53 168 145 247 223 79 78 226 15 222 82 115 70 210 27 41 1 170 40 131 192 229 248 255 == :: :: +round-constants: 5 length=16 vectors added to the state in the final layer each round ++ round-constants :: notice melt and montify: these are in Montgomery representation ^~ ^- (list melt) %- turn :_ montify :: length = num-rounds * state-size = 80 :~ :: 1st round constants 13.630.775.303.355.457.758 16.896.927.574.093.233.874 10.379.449.653.650.130.495 1.965.408.364.413.093.495 15.232.538.947.090.185.111 15.892.634.398.091.747.074 3.989.134.140.024.871.768 2.851.411.912.127.730.865 8.709.136.439.293.758.776 3.694.858.669.662.939.734 12.692.440.244.315.327.141 10.722.316.166.358.076.749 12.745.429.320.441.639.448 17.932.424.223.723.990.421 7.558.102.534.867.937.463 15.551.047.435.855.531.404 :: 2nd round constants 17.532.528.648.579.384.106 5.216.785.850.422.679.555 15.418.071.332.095.031.847 11.921.929.762.955.146.258 9.738.718.993.677.019.874 3.464.580.399.432.997.147 13.408.434.769.117.164.050 264.428.218.649.616.431 4.436.247.869.008.081.381 4.063.129.435.850.804.221 2.865.073.155.741.120.117 5.749.834.437.609.765.994 6.804.196.764.189.408.435 17.060.469.201.292.988.508 9.475.383.556.737.206.708 12.876.344.085.611.465.020 :: 3rd round constants 13.835.756.199.368.269.249 1.648.753.455.944.344.172 9.836.124.473.569.258.483 12.867.641.597.107.932.229 11.254.152.636.692.960.595 16.550.832.737.139.861.108 11.861.573.970.480.733.262 1.256.660.473.588.673.495 13.879.506.000.676.455.136 10.564.103.842.682.358.721 16.142.842.524.796.397.521 3.287.098.591.948.630.584 685.911.471.061.284.805 5.285.298.776.918.878.023 18.310.953.571.768.047.354 3.142.266.350.630.002.035 :: 4th round constants 549.990.724.933.663.297 4.901.984.846.118.077.401 11.458.643.033.696.775.769 8.706.785.264.119.212.710 12.521.758.138.015.724.072 11.877.914.062.416.978.196 11.333.318.251.134.523.752 3.933.899.631.278.608.623 16.635.128.972.021.157.924 10.291.337.173.108.950.450 4.142.107.155.024.199.350 16.973.934.533.787.743.537 11.068.111.539.125.175.221 17.546.769.694.830.203.606 5.315.217.744.825.068.993 4.609.594.252.909.613.081 :: 5th round constants 3.350.107.164.315.270.407 17.715.942.834.299.349.177 9.600.609.149.219.873.996 12.894.357.635.820.003.949 4.597.649.658.040.514.631 7.735.563.950.920.491.847 1.663.379.455.870.887.181 13.889.298.103.638.829.706 7.375.530.351.220.884.434 3.502.022.433.285.269.151 9.231.805.330.431.056.952 9.252.272.755.288.523.725 10.014.268.662.326.746.219 15.565.031.632.950.843.234 1.209.725.273.521.819.323 6.024.642.864.597.845.108 == :: :: +mds-matrix-first-column: the mds matrix is determined by any column ++ mds-matrix-first-column :: length = state-size = 16 ^- (list belt) :~ 61.402 1.108 28.750 33.823 7.454 43.244 53.865 12.034 56.951 27.521 41.351 40.901 12.021 59.689 26.798 17.845 == :: ++ mds-first-column-fft ^- (list belt) :~ 524.757 12.925.608.463.476.951.657 15.523.111.717.718.611.263 16.532.524.212.944.612.299 7.588.283.897.142.562.168 15.572.835.691.259.601.621 2.891.241.344.421.052.990 4.554.321.248.572.910.116 52.427 3.009.663.708.287.279.710 15.424.499.013.074.857.791 4.457.503.309.926.164.732 10.858.460.172.271.996.281 243.395.401.255.089.650 3.054.636.063.615.042.110 16.491.124.241.935.763.107 == :: :: list of rows ++ mds-matrix ^~ ^- (list (list belt)) |^ ^~((gen-circulant-matrix mds-matrix-first-column)) :: :: +gen-circulant-matrix: use first column to produce mds-matrix :: :: The first row of mds is a cyclic rotation of the flop of the :: first column, and successive rows are obtained by more cyclic :: rotations. ++ gen-circulant-matrix |= first-column=(list @) ^- (list (list @)) %+ spun (range (lent first-column)) |= [i=@ acc=_(flop first-column)] [(rotate acc) (rotate acc)] :: :: +rotate: cyclic vector rotation ++ rotate |= lst=(list @) ^- (list @) [(rear lst) (snip lst)] -- :: ++ primitive-16-roots ^- (list belt) :~ 4.096 :: o (o=2^12; 2 is a primitive 192nd rou, & 192=12*16) 68.719.476.736 :: o^3 1.152.921.504.606.846.976 :: o^5 4.503.599.626.321.920 :: o^7 18.446.744.069.414.580.225 :: o^9 18.446.744.000.695.107.585 :: o^11 17.293.822.564.807.737.345 :: o^13 18.442.240.469.788.262.401 :: o^15 == :: ++ layer-two-twiddles ^~ ^- (map belt (list belt)) %- ~(gas by *(map belt (list belt))) %+ turn primitive-16-roots |= r=belt =/ fourth-rou (bpow r (div 16 4)) :- r (turn (range 2) |=(i=@ (bpow fourth-rou i))) :: ++ layer-three-twiddles ^~ ^- (map belt (list belt)) %- ~(gas by *(map belt (list belt))) %+ turn primitive-16-roots |= r=belt =/ eighth-rou (bpow r (div 16 8)) :- r (turn (range 4) |=(i=@ (bpow eighth-rou i))) :: ++ layer-four-twiddles ^~ ^- (map belt (list belt)) %- ~(gas by *(map belt (list belt))) %+ turn primitive-16-roots |= r=belt :- r (turn (range 8) |=(i=@ (bpow r i))) :: :: :: For the cognoscenti: :: :: The formal mathematical specification of Tip5 involves conversion to :: and from Montgomery representation in the S-box layer of each round. :: In practice it is inefficient to do this, so the MDS and round constants :: layers are done in Montgomery representation. This demands that the :: round constants be given in Montgomery representation, but, confusingly :: enough, does not demand the same of the MDS matrix constants, for the :: simple reason that ordinary multiplication of melt a' (whose underlying :: belt is a) and belt b yields (ab)'; this owes to the fact that :: "Montification" is multiplication by 2^64 mod p = 2^32 - 1. Basically, :: we "stay in Montgomery space" if we multiply a melt and a belt. :: :: This manifests clearly in +hash-10, where the input is montified and :: the output is demontified before being returned. +| %dev-funcs ++ init-tip5-state |= =domain ^- tip5-state ?- domain %variable ^~((reap state-size 0)) :: %fixed ^~((weld (reap rate 0) (reap capacity (montify 1)))) == :: :: +offset-fermat-cube-map: generates and can be used to test lookup-table ++ offset-fermat-cube-map |= x=@ ^- @ ?> (lth x 256) =/ xx +(x) %- mod :_ 257 (add :(mul xx xx xx) 256) :: :: +split-and-lookup: splits b into bytes, applies offset-fermat-cube-map to each, & recombines bytes ++ split-and-lookup |= m=melt ^- melt :: split =/ bytes=(list @) (weld (rip 3 m) (reap (sub 8 (lent (rip 3 m))) 0)) :: lookup=offset-fermat-cube =. bytes (turn bytes |=(byte=@ (snag byte lookup-table))) :: recombine (can 3 (zip-up (reap 8 1) bytes)) :: :: +cyclomul16-fft: fft of f and g, hadamard multiply result, then ifft. :: :: This is different than polynomial multiplication of f and g bc output length equals input lengths. :: In fact, it is polynomial multiplication modulo the cyclotomic polynomial X^16 - 1. (Not obvious.) ++ cyclomul16-fft |= [f=(list belt) g=(list belt)] ^- (list belt) ?> ?&(=((lent f) state-size) =((lent g) state-size)) =/ [fx=fpoly gx=fpoly] [(lift-to-fpoly f) (lift-to-fpoly g)] %- turn :_ drop %- fpoly-to-list (fp-ifft (~(zip fop (fp-fft fx)) (fp-fft gx) fmul)) :: :: +fft-16-w-root: ++ fft-16-w-root ~/ %fft-16-w-root |= [bp=(list belt) r=belt] ^- (list belt) |^ =/ current-layer=(list (list belt)) %- turn :_ interpolate-linear (zip-up (scag 8 bp) (slag 8 bp)) =. current-layer %+ turn (zip-up (scag 4 current-layer) (slag 4 current-layer)) (cury interpolate-next (~(got by layer-two-twiddles) r)) =/ current-layer %+ turn (zip-up (scag 2 current-layer) (slag 2 current-layer)) (cury interpolate-next (~(got by layer-three-twiddles) r)) %- interpolate-next :+ (~(got by layer-four-twiddles) r) (snag 0 current-layer) (snag 1 current-layer) :: ++ interpolate-linear |= [b=belt c=belt] ~[(badd b c) (bsub b c)] :: ++ interpolate-next |= [twids=(list belt) dft1=(list belt) dft2=(list belt)] ^- (list belt) =/ right (zip dft2 twids bmul) %+ weld (zip dft1 right badd) (zip dft1 right bsub) -- :: ++ fft-16 ~/ %fft-16 |= bp=(list belt) (fft-16-w-root bp 4.096) :: ++ ifft-16 ~/ %ifft-16 |= evals=(list belt) ^- (list belt) %- turn :_ |=(=belt (bmul belt 17.293.822.565.076.172.801)) (fft-16-w-root evals 18.442.240.469.788.262.401) :: :: +mds-cyclomul: applies the mds matrix as a linear transformation to state :: w/o doing matrix multiplication ++ mds-cyclomul ~/ %mds-cyclomul |= =state ^- ^state %- ifft-16 (zip mds-first-column-fft (fft-16 state) bmul) :: :: +mds-cyclomul-m: applies the mds matrix as a linear transformation to state :: doing matrix multiplication. ++ mds-cyclomul-m ~/ %mds-cyclomul-m |= v=(list @) ^- (list @) %+ turn mds-matrix |= row=(list @) (mod (inner-product row v) p) :: ++ inner-product ~/ %inner-product |= [l=(list @) t=(list @)] ^- belt %^ zip-roll l t |= [[a=@ b=@] res=@] (add res (mul a b)) :: :: +sbox-layer: applies fermat map to first 4 elements and 7th-power map to remainder ++ sbox-layer ~/ %sbox-layer |= =state ^- (list melt) ?> =((lent state) state-size) %+ weld (turn (scag num-split-and-lookup state) split-and-lookup) %+ turn (slag num-split-and-lookup state) :: computes b^7 in 4 base field multiplications :: :: Note that we are able to replace montiplys with :: bmuls due to the fact that R^3 = 1 mod p. Thus: :: m^7 = R^7*b^7 :: = (R^3)^2*R*b^7 :: = R*b^7 mod p |= m=melt ^- melt =/ sq (bmul m m) =/ qu (bmul sq sq) :(bmul m sq qu) :: :: +round: one round has three components; sbox, linear (mds), add round constants ++ round ~/ %round |= [sponge=tip5-state round-index=@] ^- tip5-state =. sponge (mds-cyclomul-m (sbox-layer sponge)) %^ zip sponge (range state-size) |= [b=belt i=@] (badd b (snag (add (mul round-index state-size) i) round-constants)) :: :: +permutation: applies rounds iteratively, num-rounds times ++ permutation ~/ %permutation |= sponge=tip5-state ^- tip5-state %+ roll (range num-rounds) |= [round-index=@ acc=_sponge] (round acc round-index) :: :: +trace: a record of the tip5-state's evolution during permutation ++ trace ~/ %trace |= sponge=tip5-state ^- (list tip5-state) :- sponge %+ spun (range num-rounds) |= [i=@ sp=_sponge] [(round sp i) (round sp i)] :: :: +hash-10: hash list of 10 belts into a list of 5 belts ++ hash-10 ~/ %hash-10 |= input=(list belt) :: output length is 5 ^- (list belt) ?> =((lent input) rate) ?> (levy input based) =. input (turn input montify) =/ sponge (init-tip5-state %fixed) =. sponge (permutation (weld input (slag rate sponge))) (turn (scag digest-length sponge) mont-reduction) :: :: +hash-varlen: hash a list of belts, but in practice only a single belt :: :: you might think this is the function for hashing lists of belts, :: but you'd be wrong. +hash-varlen is part of the tip5 spec, so :: we need to have it. but because hoon is structurally typed, the :: type system cannot distinguish between a list ~[1 2 3] and a tuple :: [1 2 3 0]. unfortunately, +hash-noun of [1 2 3 0] is different from :: +hash-varlen of ~[1 2 3]. having identical nouns of belts with different :: hashes would be catastrophic. :: :: the two tip5 primitives are +hash-varlen and +hash-ten-cell. :: +hash-ten-cell can't be used on a single atom, so we must use :: +hash-varlen on it. +hash-ten-cell is only to be used to combine two :: hashes. so +hash-noun works out to be: +hash-varlen on every belt :: atom, and +hash-ten-cell on every cell. :: :: we also make use of +hash-varlen for hashing marys. see +hash-mary :: for more information ++ hash-varlen ~/ %hash-varlen |= input=(list belt) ^- (list belt) =/ spo (new:sponge) =. spo (absorb:spo input) =^ output spo (squeeze:spo) (scag digest-length output) :: ++ sponge ~% %sponge +> ~ |_ sponge=tip5-state ++ new |. ^+ +.$ =. sponge (init-tip5-state %variable) +.$ :: ++ absorb ~/ %absorb |= input=(list belt) ^+ +>.$ =* rng +>.$ |^ :: assert that input is made of base field elements ?> (levy input based) =/ [q=@ r=@] (dvr (lent input) rate) :: pad input with ~[1 0 ... 0] to be a multiple of rate =. input (weld input [1 (reap (dec (sub rate r)) 0)]) :: bring input into montgomery space =. input (turn input montify) |- =. sponge (absorb-rate (scag rate input)) ?: =(q 0) rng $(q (dec q), input (slag rate input)) :: ++ absorb-rate |= input=(list belt) ^+ sponge ?> =((lent input) rate) =. sponge (weld input (slag rate sponge)) $:permute -- :: ++ permute ~% %permute + ~ |. ^+ sponge (permutation sponge) :: ++ squeeze ~% %squeeze + ~ |. ^+ [*(list belt) +.$] =* rng +.$ :: squeeze out the full rate and bring out of montgomery space =/ output (turn (scag rate sponge) mont-reduction) =. sponge $:permute [output rng] -- :: :: +list-to-tuple: strips ~ from a list and yields a tuple :: :: hash-10 returns a length=5 list and this function is useful :: for converting it to a tuple ++ list-to-tuple ~/ %list-to-tuple |= lis=(list @) :: address of [a_{k-1} ~] (final nontrivial tail of list) =+ (dec (bex (lent lis))) .* lis [10 [- [0 (mul 2 -)]] [0 1]] :: :: +tog: Tip5 Sponge PRNG :: ++ tog ~% %tog +> ~ |_ spo=tip5-state :: ++ new |= sponge-state=tip5-state ~(. tog sponge-state) :: ++ belts ~/ %belts |= n=@ ^+ [*(list belt) +>.$] =* rng +>.$ =/ sponge ~(. sponge spo) =/ [q=@ r=@] (dvr n rate) =| output=(list belt) |- =^ out sponge (squeeze:sponge) =. spo sponge:sponge ?: =(q 0) [(weld output (scag r out)) rng] $(q (dec q), output (weld output out)) :: ++ felt ~% %felt + ~ |. ^+ [*^felt +.$] =^ felt-list +.$ (felts 1) [(head felt-list) +.$] :: ++ felts ~/ %felts |= n=@ ^+ [*(list ^felt) +>.$] =* outer +>.$ =^ lis-belts +>.$ (belts (mul n 3)) =| ret=(list ^felt) =/ i 0 |- ?: =(i n) [(flop ret) outer] =/ f=^felt (frep (scag 3 lis-belts)) $(ret [f ret], lis-belts (slag 3 lis-belts), i +(i)) :: ++ index ~/ %index |= size=@ ^+ [*@ +>.$] =^ belt-list +>.$ (belts 1) [(mod (head belt-list) size) +>.$] :: ++ indices ~/ %indices |= [n=@ size=@ reduced-size=@] ^+ [*(list @) +>.$] =* rng +>.$ ~| "cannot sample more indices than available in last codeword" ?> (lte n reduced-size) =| indices=(list @) =| reduced-indices=(list @) |- ?: (gte (lent indices) n) [(flop indices) rng] =^ index rng (index size) =/ reduced-index (mod index reduced-size) ?^ (find reduced-index^~ reduced-indices) $ ?^ (find index^~ indices) $ %_ $ indices [index indices] reduced-indices [reduced-index reduced-indices] == -- :: ++ test-tip5 |% :: ++ lookup-table-test ^- ? ?> =((lent lookup-table) 256) %+ levy (range 256) |= i=@ =((snag i lookup-table) (offset-fermat-cube-map i)) :: ++ fermat-cube-map-is-permutation ^- ? =((range 256) (sort lookup-table lth)) :: :: needs Blake3 hash function; I've painstakingly checked our list against the one in Neptune's code ++ round-constants-test ^- ? !! :: :: +reduce-mod-cyclotomic: reduce f mod X^n-1 ++ reduce-mod-cyclotomic |= [f=(list belt) n=@] ^- (list belt) =. f (weld f (reap (sub n (mod (lent f) n)) 0)) =/ result (reap n 0) |- ?~ f result =/ f-lst `(list belt)`f %_ $ f (slag n f-lst) result (zip (scag n f-lst) result badd) == :: ++ cyclomul-is-bpmul-mod-cyclotomic-test |= [f=(list belt) g=(list belt)] ^- ? ?> ?&((lte (lent f) 16) (lte (lent g) 16)) =. f (weld f (reap (sub 16 (lent f)) 0)) =. g (weld g (reap (sub 16 (lent g)) 0)) =/ prod=(list belt) (bpoly-to-list (bpmul (init-bpoly f) (init-bpoly g))) =. prod (weld prod (reap (sub 32 (lent prod)) 0)) .= (cyclomul16-fft f g) (zip (scag 16 prod) (slag 16 prod) badd) :: ++ matrix-vector-product |= [matrix=(list (list belt)) vector=(list belt)] ^- (list belt) %+ turn matrix :: dot product |= row=(list belt) ^- belt %+ roll (zip-up row vector) |= [[entry=belt component=belt] acc=belt] ^- belt (badd acc (bmul entry component)) :: ++ mds-cyclomul-test |= input=(list belt) ^- ? ?> =((lent input) 16) =((mds-cyclomul input) (matrix-vector-product mds-matrix input)) :: ++ test-hash10-0 =/ expected=(list belt) :~ 941.080.798.860.502.477 5.295.886.365.985.465.639 14.728.839.126.885.177.993 10.358.449.902.914.633.406 14.220.746.792.122.877.272 == =/ got (hash-10 (reap 10 0)) (zip-up expected got) :: ++ hash10-test-vectors ^- ? =/ input=(list belt) (reap rate 0) =+ %+ roll (range 6) |= [i=@ in=_input] =/ out (hash-10 in) :(weld (scag i in) out (reap (sub 5 i) 0)) =/ digest (hash-10 -) =/ final=(list belt) :~ 10.869.784.347.448.351.760 1.853.783.032.222.938.415 6.856.460.589.287.344.822 17.178.399.545.409.290.325 7.650.660.984.651.717.733 == =/ expected-got=(list [belt belt]) (zip-up final digest) ~& expected-got (levy expected-got |=([a=belt b=belt] =(a b))) :: :: comment out the jet hint on hash-varlen before running this test ++ test-hash-varlen |= [num=@ seed=@] ^- ? |^ =| counter=@ |- ?: =(counter num) %.y =/ [tv=(list belt) new-seed=@] %^ spin (range counter) seed |= [i=@ sd=belt] =- -^- (badd (bmul sd sd) 1) ?. =((hash-varlen tv) (old-hash-varlen tv)) ~& fail-on+tv %.n $(counter +(counter), seed new-seed) :: ++ old-hash-varlen |= input=(list belt) =/ [q=@ r=@] (dvr (lent input) rate) :: append ~[1 0 ... 0] to input =. input (turn (weld input [1 (reap (dec (sub rate r)) 0)]) montify) =/ sponge (init-tip5-state %variable) =- (turn (scag digest-length sp) mont-reduction) %+ roll (gulf 0 q) |= [i=@ [sp=_sponge in=_input]] :_ (slag rate in) (permutation (weld (scag rate in) (slag rate sp))) -- -- -- :: :: TODO: needs to be audited and thoroughly tested ++ cheetah ~% %cheetah ..cheetah ~ :: degree-six extension of F_p is cheetah curve's base field |% :: f6lt: element of F_p[x]/(x^6 - 7) +$ f6lt [a0=belt a1=belt a2=belt a3=belt a4=belt a5=belt] ++ f6lt-dyck-word ^- (list @) ~[0 1 0 1 0 1 0 1 0 1] ++ f6lt-cell-dyck-word ^~ ^- (list @) (weld [0 f6lt-dyck-word] [1 f6lt-dyck-word]) ++ f6lt-triple-dyck-word ^~ ^- (list @) :(weld [0 f6lt-dyck-word] [1 [0 f6lt-dyck-word]] [1 f6lt-dyck-word]) ++ f6lt-triple-cell-dyck-word ^~ ^- (list @) (weld [0 f6lt-triple-dyck-word] [1 f6lt-triple-dyck-word]) ++ f6-zero `f6lt`[0 0 0 0 0 0] ++ f6-one `f6lt`[1 0 0 0 0 0] :: ++ f6lt-to-list |= f=f6lt ^- (list belt) ~[a0.f a1.f a2.f a3.f a4.f a5.f] :: ++ list-to-f6lt |= lis=(list belt) ^- f6lt ?> =((lent lis) 6) :: 63 = axis of [a_5 ~] in ~[a0 ... a_5] :: 126 = axis of a_5 in ~[a0 ... a_5] :: replace axis 63 (=[a_5 ~]) of *[lis [0 1]]=lis with *[lis [0 126]]=a_5 =/ n .* lis [10 [63 [0 126]] [0 1]] ?> ?=(f6lt n) n :: ++ f6-add |= [f1=f6lt f2=f6lt] ^- f6lt :* (badd a0.f1 a0.f2) (badd a1.f1 a1.f2) (badd a2.f1 a2.f2) (badd a3.f1 a3.f2) (badd a4.f1 a4.f2) (badd a5.f1 a5.f2) == :: ++ f6-neg |= f=f6lt ^- f6lt :* (bneg a0.f) (bneg a1.f) (bneg a2.f) (bneg a3.f) (bneg a4.f) (bneg a5.f) == :: ++ f6-sub |= [f1=f6lt f2=f6lt] ^- f6lt (f6-add f1 (f6-neg f2)) :: ++ f6-scal |= [c=belt f=f6lt] ^- f6lt :* (bmul c a0.f) (bmul c a1.f) (bmul c a2.f) (bmul c a3.f) (bmul c a4.f) (bmul c a5.f) == :: :: +karat3: mults 2 quadratic polys w only 6 bmuls (vs naive 9) ++ karat3 |= [[a0=belt a1=belt a2=belt] [b0=belt b1=belt b2=belt]] ^- [c0=belt c1=belt c2=belt c3=belt c4=belt] =/ [m0=belt m1=belt m2=belt] [(bmul a0 b0) (bmul a1 b1) (bmul a2 b2)] :* m0 (bsub (bmul (badd a0 a1) (badd b0 b1)) (badd m0 m1)) (badd (bsub (bmul (badd a0 a2) (badd b0 b2)) (badd m0 m2)) m1) (bsub (bmul (badd a1 a2) (badd b1 b2)) (badd m1 m2)) m2 == :: :: +karat3-square: squares quadratic poly w only 5 bmuls ++ karat3-square |= [a0=belt a1=belt a2=belt] ^- [c0=belt c1=belt c2=belt c3=belt c4=belt] =/ [m0=belt m2=belt] [(bmul a0 a0) (bmul a2 a2)] =/ [n01=belt n12=belt] [(bmul a0 a1) (bmul a1 a2)] =: n01 (badd n01 n01) n12 (badd n12 n12) == =/ tri2=belt =/ tri :(badd a0 a1 a2) (bmul tri tri) =/ coeff2 (bsub tri2 :(badd m0 m2 n01 n12)) [m0 n01 coeff2 n12 m2] :: ++ f6-mul |= [f=f6lt g=f6lt] ^- f6lt =/ f0g0 (karat3 [a0.f a1.f a2.f] [a0.g a1.g a2.g]) =/ f1g1 (karat3 [a3.f a4.f a5.f] [a3.g a4.g a5.g]) =/ foil %- karat3 :- [(badd a0.f a3.f) (badd a1.f a4.f) (badd a2.f a5.f)] [(badd a0.g a3.g) (badd a1.g a4.g) (badd a2.g a5.g)] =/ cross=[c0=belt c1=belt c2=belt c3=belt c4=belt] :* (bsub c0.foil (badd c0.f0g0 c0.f1g1)) (bsub c1.foil (badd c1.f0g0 c1.f1g1)) (bsub c2.foil (badd c2.f0g0 c2.f1g1)) (bsub c3.foil (badd c3.f0g0 c3.f1g1)) (bsub c4.foil (badd c4.f0g0 c4.f1g1)) == :* (badd c0.f0g0 (bmul 7 (badd c3.cross c0.f1g1))) (badd c1.f0g0 (bmul 7 (badd c4.cross c1.f1g1))) (badd c2.f0g0 (bmul 7 c2.f1g1)) :(badd c3.f0g0 c0.cross (bmul 7 c3.f1g1)) :(badd c4.f0g0 c1.cross (bmul 7 c4.f1g1)) c2.cross == :: :: +f6-square: uses karat3-square for more efficiency than (f6-mul f f) ++ f6-square |= f=f6lt ^- f6lt =/ lo [a0.f a1.f a2.f] =/ hi [a3.f a4.f a5.f] =/ lo2 (karat3-square lo) =/ hi2 (karat3-square hi) =/ folded2 :: (lo + hi)^2 (karat3-square [(badd a0.f a3.f) (badd a1.f a4.f) (badd a2.f a5.f)]) =/ cross=[c0=belt c1=belt c2=belt c3=belt c4=belt] :* (bsub c0.folded2 (badd c0.lo2 c0.hi2)) (bsub c1.folded2 (badd c1.lo2 c1.hi2)) (bsub c2.folded2 (badd c2.lo2 c2.hi2)) (bsub c3.folded2 (badd c3.lo2 c3.hi2)) (bsub c4.folded2 (badd c4.lo2 c4.hi2)) == :* :(badd c0.lo2 (bmul 7 c3.cross) (bmul 7 c0.hi2)) :(badd c1.lo2 (bmul 7 c4.cross) (bmul 7 c1.hi2)) (badd c2.lo2 (bmul 7 c2.hi2)) :(badd c3.lo2 c0.cross (bmul 7 c3.hi2)) :(badd c4.lo2 c1.cross (bmul 7 c4.hi2)) c2.cross == :: ++ f6-pow |= [f=f6lt n=@] ^- f6lt =/ acc=f6lt f6-one |- ?: =(n 0) acc %_ $ acc ?:(=((end 0 n) 0) acc (f6-mul acc f)) f (f6-square f) n (rsh 0 n) == :: ++ f6-inv |= f=f6lt ^- f6lt =/ eucl %+ bpegcd (init-bpoly (f6lt-to-list f)) (init-bpoly ~[(bneg 7) 0 0 0 0 0 1]) %- list-to-f6lt =+ %- bpoly-to-list (bpscal (binv (snag 0 (bpoly-to-list d.eucl))) u.eucl) (weld - (reap (sub 6 (lent -)) 0)) :: ++ f6-div |= [f1=f6lt f2=f6lt] ^- f6lt (f6-mul f1 (f6-inv f2)) :: :: elliptic cheetah curve operations ++ curve ~% %curve ..curve ~ |% ++ b `f6lt`[395 1 0 0 0 0] :: :: +gx: x-coordinate of g in affine coordinates ++ gx ^- f6lt :* 2.754.611.494.552.410.273 8.599.518.745.794.843.693 10.526.511.002.404.673.680 4.830.863.958.577.994.148 375.185.138.577.093.320 12.938.930.721.685.970.739 == :: +gy: y-coordinate of g in affine coordinates ++ gy ^- f6lt :* 15.384.029.202.802.550.068 2.774.812.795.997.841.935 14.375.303.400.746.062.753 10.708.493.419.890.101.954 13.187.678.623.570.541.764 9.990.732.138.772.505.951 == :: :: +g-order: order of g; 255 bits ++ g-order 0x7af2.599b.3b3f.22d0.563f.bf0f.990a.37b5.327a.a723.3015.7722.d443.623e.aed4.accf :: +a-pt: affine coordinates :: :: If the infinity flag inf if %.n, this is an (x, y) point in the :: affine plane, which we identify with the z=1 plane in projective :: space. If %.y, this is a point on the projective line :: "at infinity," i.e. (x, y) is identified with [x, y, 0] in :: projective space. By the projective equivalence relation, this :: representation is not unique. +$ a-pt [x=f6lt y=f6lt inf=?] ++ a-pt-dyck-word ^~ ^- (list @) (snoc (weld [0 f6lt-dyck-word] [1 0 f6lt-dyck-word]) 1) ++ a-pt-cell-dyck-word ^~ ^- (list @) (weld [0 a-pt-dyck-word] [1 a-pt-dyck-word]) :: :: +a-id :: :: The curve is defined by y^2 = x^3 + x + b over F^6. :: To add the point at infinity we interpret these (x, y) :: points as [x, y, 1] in P^2 over F^6. In projective [x, y, z] :: coordinates the equation is y^2z = x^3 + xz^2 + bz^3. A :: point at infinity (z=0), must satisfy x^3=0 so [0, y, 0] (y≠0) :: is the only point at infinity on the curve (this is the same :: pt for any y by the projective equivalence relation). Thus we :: can take [0 1 %.y] as the identity point. :: :: Note that [0 -1 %.y] also represents the identity point. ++ a-id `a-pt`[f6-zero f6-one %.y] ++ a-gen ^- a-pt [gx gy %.n] :: :: +affine: curve operations in affine coordinates ++ affine ~% %affine ..affine ~ |% ++ in-g |= p=a-pt =(a-id (ch-scal g-order p)) :: :: +ch-neg: negate a cheetah point :: :: In Weierstrass form an elliptic curve has f([x y z]) = [x -y z] symmetry. :: The line in the z=constant plane thru p and f(p) is vertical so passes :: through O, the point at infinity; thus by the straight line relation for :: elliptic curve addition, p + f(p) + O = O i.e. f(p) = -p. ++ ch-neg |= p=a-pt ^- a-pt [x.p (f6-neg y.p) inf.p] :: :: +ch-add: add two cheetah points ++ ch-add-unsafe |= [p=a-pt q=a-pt] ^- a-pt =/ slope (f6-div (f6-sub y.p y.q) (f6-sub x.p x.q)) =/ x-out (f6-sub (f6-square slope) (f6-add x.p x.q)) :+ x-out (f6-sub (f6-mul slope (f6-sub x.p x-out)) y.p) %.n :: ++ ch-add |= [p=a-pt q=a-pt] ^- a-pt ?: inf.p q ?: inf.q p ?: =(p (ch-neg q)) a-id ?: =(p q) (ch-double p) (ch-add-unsafe p q) :: :: +ch-double-unsafe: generic add w/o special case checks ++ ch-double-unsafe |= p=a-pt ^- a-pt =/ slope %+ f6-div (f6-add (f6-scal 3 (f6-square x.p)) f6-one) (f6-scal 2 y.p) =/ x-out (f6-sub (f6-square slope) (f6-scal 2 x.p)) :+ x-out (f6-sub (f6-mul slope (f6-sub x.p x-out)) y.p) %.n :: :: +ch-double: [2]p, p a cheetah point :: :: Analog of squaring; fundamental for computing [n]p quickly. :: Two special cases: the double of the point at infinity is itself; :: and the double of any point with infinite slope is infinite. A :: point with infinite slope is any point with y=0 by the equation :: dy/dx = (3x^2 + 1)/2y. ++ ch-double |= p=a-pt ^- a-pt ?: inf.p a-id ?: =(y.p f6-zero) a-id (ch-double-unsafe p) :: :: +ch-scal: compute [n]p, p a cheetah point :: :: This is the action of Z on cheetah as an abelian group. ++ ch-scal |= [n=@ p=a-pt] ^- a-pt =/ acc a-id |- ?: =(n 0) acc %_ $ acc ?:(=((end 0 n) 0) acc (ch-add acc p)) n (rsh 0 n) p (ch-double p) == -- -- :: ++ schnorr ~% %schnorr ..schnorr ~ |% ++ affine ~% %affine ..affine ~ |% ++ sign ~/ %sign |= [sk-as-32-bit-belts=(list belt) m=(list belt)] ^- [c=@ux s=@ux] ?> =((lent m) 5) =/ b-32 (bex 32) ?> (levy sk-as-32-bit-belts |=(n=@ (lth n b-32))) =/ sk (rep 5 sk-as-32-bit-belts) ?< =(sk 0) ?> (lth sk g-order:curve) =/ pubkey (ch-scal:affine:curve sk a-gen:curve) =/ transcript=(list (list belt)) [(f6lt-to-list x.pubkey) (f6lt-to-list y.pubkey) m ~] =/ nonce (trunc-g-order (hash-varlen:tip5 (zing transcript))) ?< =(nonce 0) =/ scalar (ch-scal:affine:curve nonce a-gen:curve) =. transcript [(f6lt-to-list x.scalar) (f6lt-to-list y.scalar) transcript] =/ chal (trunc-g-order (hash-varlen:tip5 (zing transcript))) ?< =(chal 0) =/ sig %+ mod (add nonce (mul chal sk)) g-order:curve ?< =(sig 0) [chal sig] :: ++ verify ~/ %verify |= [pubkey=a-pt:curve m=(list belt) chal=@ux sig=@ux] ^- ? ?& =((lent m) 5) :: m must be a tip5 hash (gth chal 0) (lth chal g-order:curve) :: (gth sig 0) (lth sig g-order:curve) :: =/ scalar %+ ch-add:affine:curve (ch-scal:affine:curve sig a-gen:curve) (ch-neg:affine:curve (ch-scal:affine:curve chal pubkey)) ?< =(scalar f6-zero) .= chal %- trunc-g-order %- hash-varlen:tip5 %- zing :~ (f6lt-to-list x.scalar) (f6lt-to-list y.scalar) (f6lt-to-list x.pubkey) (f6lt-to-list y.pubkey) m == == -- -- :: :: +trunc-g-order: truncates a list of ≥4 belts to a 255-bit number ++ trunc-g-order |= a=(list belt) ^- @ %+ mod ;: add (snag 0 a) (mul p (snag 1 a)) :(mul p p (snag 2 a)) :(mul p p p (snag 3 a)) == g-order:curve :: :: +a-pt-to-base58: concatenate a-pt coords :: :: we treat an a-pt as 12 64-bit atoms (6 for x, 6 for y). we concatenate them as :: fixed-width atoms, put a leading 1 in front of it, and then :: convert to a base58 cord. :: :: we crash when inf=%.y since that is for projective coordinates, which does not :: have a unique representation and so must be treated differently. ++ a-pt-to-base58 ~/ %a-pt-to-base58 |= a=a-pt:curve ^- cord ?: inf.a !! (crip (en-base58 (ser-a-pt a))) :: ++ ser-a-pt ~/ %ser-a-pt |= a=a-pt:curve ^- @ux ?> &((in-g:affine:curve a) !=(a-id:curve p)) ?: inf.a !! %+ rep 6 :: 64 bit atoms :~ a0.x.a a1.x.a a2.x.a a3.x.a a4.x.a a5.x.a a0.y.a a1.y.a a2.y.a a3.y.a a4.y.a a5.y.a 1 :: the leading 1 == :: ++ de-a-pt ~/ %de-a-pt |= a=@ux ^- a-pt:curve |^ =/ pt-list=(list @) (rip-correct 6 a) =/ x=f6lt (conv (scag 6 pt-list)) =/ y=f6lt (conv (scag 6 (oust [0 6] pt-list))) :: :: We assume the point we are provided is not projective :: and set inf to %.n. This will be true so long :: as `a` was encoded using ser-a-pt. This also means that a-pt :: will never be the identity point, so we skip the check. =/ =a-pt:curve [x y %.n] ?> (in-g:affine:curve a-pt) a-pt ++ conv |= n=(list @) ^- f6lt :* (snag 0 n) (snag 1 n) (snag 2 n) (snag 3 n) (snag 4 n) (snag 5 n) == -- ++ base58-to-a-pt ~/ %base58-to-a-pt |= a=cord ^- a-pt:curve (de-a-pt (de-base58 (trip a))) :: :: :: :: +belt-schnorr: a wrapper for Schnorr signatures that works only with belts :: TODO: audit this around how rip and rep are used ++ belt-schnorr |% +$ t8 [@ux @ux @ux @ux @ux @ux @ux @ux] :: 8-tuple of belts +$ sk t8 +$ sig t8 +$ chal t8 :: ++ atom-to-t8 |= a=@ux ^- t8 =/ ripped=(list @) (rip-correct 5 a) :: most of the time, .rippped will be 8 @, but if it has enough leading :: zeroes then it won't. +rip reverses the endianness, so we put the :: leading zeroes at the end. =/ length-dif=@ (sub 8 (lent ripped)) =. ripped (weld ripped (reap length-dif 0)) ;;(t8 (list-to-tuple:tip5 (rip-correct 5 a))) :: ++ t8-to-atom |= t=t8 ^- @ux (rap 5 (leaf-sequence:shape t)) :: ++ t8-to-list |= t=t8 ^- (list belt) (leaf-sequence:shape t) :: ++ affine |% ++ sign |= [=sk m=(list belt)] ^- [c=chal s=sig] =/ [c=@ux s=@ux] (sign:affine:schnorr (t8-to-list sk) m) [(atom-to-t8 c) (atom-to-t8 s)] :: ++ verify |= [pk=a-pt:curve m=(list belt) =chal =sig] ^- ? %- verify:affine:schnorr :* pk m (t8-to-atom chal) (t8-to-atom sig) == -- ::+affine -- ::+belt-schnorr -- ::+cheetah :: ++ merkle :: /lib/merkle ~% %merkle ..merkle ~ |% +| %types :: TODO: switch merk over to this type once tip5 changes are finalized ++ other-merk |$ node $: h=noun-digest:tip5 $@ ~ (pair (merk node) (merk node)) == ++ merk |$ [node] $~ [%leaf *noun-digest:tip5 ~] $% [%leaf h=noun-digest:tip5 ~] [%tree h=noun-digest:tip5 t=(pair (merk node) (merk node))] == +$ vector (list @) :: replace with bitvector +$ merk-proof [root=noun-digest:tip5 path=(list noun-digest:tip5)] +$ merk-heap [h=noun-digest:tip5 m=mary] ++ mee |$ [node] $~ [%leaf *node] $% [%leaf n=node] [%tree l=(mee node) r=(mee node)] == :: +| %work ++ build-merk ~/ %build-merk |= m=mary ^- (pair @ (merk mary)) =/ [h=@ n=(mee mary)] (list-to-balanced-tree m) :- h |- ?: ?=([%leaf *] n) [%leaf (hash-hashable:tip5 (hashable-mary:tip5 n.n)) ~] =/ l=(merk mary) $(n l.n) =/ r=(merk mary) $(n r.n) [%tree (hash-ten-cell:tip5 h.l h.r) l r] :: ++ build-merk-heap ~/ %build-merk-heap |= m=mary ^- [depth=@ heap=merk-heap] |^ =/ heap-mary (heapify-mary m) :- (xeb len.array.m) [(snag-as-digest:tip5 heap-mary 0) heap-mary] :: :: +heapify-mary :: Take a mary of felts, merklize it, and return it as a heap ++ heapify-mary |= m=mary ^- mary =/ size (dec (bex (xeb len.array.m))) =/ high-bit (lsh [6 (mul size 5)] 1) :: make leaves =/ res=(list (list @)) %+ turn (range len.array.m) |= i=@ =/ t (~(snag-as-fpoly ave m) i) (leaf-sequence:shape (hash-hashable:tip5 (hashable-fpoly:tip5 t))) :+ 5 size %+ add high-bit %+ rep 6 %- zing ^- (list (list @)) =/ curr res |- ?: =((lent curr) 1) res =/ pairs (hash-pairs:tip5 curr) %= $ res (weld pairs res) curr pairs == -- :: ++ bp-build-merk-heap ~/ %bp-build-merk-heap |= m=mary ^- (pair @ merk-heap) |^ =/ heap-mary (heapify-mary m) :- (xeb len.array.m) [(snag-as-digest:tip5 heap-mary 0) heap-mary] :: :: +heapify-mary :: Take a mary of belts, merklize it, and return it as a heap ++ heapify-mary |= m=mary ^- mary =/ size (dec (bex (xeb len.array.m))) =/ high-bit (lsh [6 (mul size 5)] 1) :: make leaves =/ res=(list (list @)) %+ turn (range len.array.m) |= i=@ =/ t (~(snag-as-bpoly ave m) i) (leaf-sequence:shape (hash-hashable:tip5 (hashable-bpoly:tip5 t))) :+ 5 size %+ add high-bit %+ rep 6 %- zing ^- (list (list @)) =/ curr res |- ?: =((lent curr) 1) res =/ pairs (hash-pairs:tip5 curr) %= $ res (weld pairs res) curr pairs == -- :: ++ index-to-axis ~/ %index-to-axis |= [h=@ i=@] ^- axis =/ min (bex (dec h)) (add min i) :: ++ list-to-balanced-merk ~/ %list-to-balanced-merk |= lis=mary ^- (pair @ (merk mary)) (build-merk lis) :: ++ list-to-balanced-tree ~/ %list-to-balanced-tree |= lis=mary ^- [h=@ t=(mee mary)] :- (xeb len.array.lis) |- ?> !=(0 len.array.lis) =/ len len.array.lis ?: =(1 len) [%leaf (~(change-step ave [step.lis 1 (~(snag ave lis) 0)]) 3)] ?: =(2 len) :+ %tree [%leaf (~(change-step ave [step.lis 1 (~(snag ave lis) 0)]) 3)] [%leaf (~(change-step ave [step.lis 1 (~(snag ave lis) 1)]) 3)] =/ l=(mee mary) ?: =((mod len 2) 0) $(lis (~(scag ave lis) (div len 2))) $(lis (~(scag ave lis) +((div len 2)))) =/ r=(mee mary) ?: =((mod len 2) 0) $(lis (~(slag ave lis) (div len 2))) $(lis (~(slag ave lis) +((div len 2)))) [%tree l r] :: ++ build-merk-proof ~/ %build-merk-proof |= [merk=merk-heap axis=@] ^- merk-proof ?: =(0 axis) !! :- h.merk ?: =(1 axis) ~ :: :: Convert axis to heap index by decrementing =. axis (dec axis) ^- (list noun-digest:tip5) |- ?: =(0 axis) ~ =/ parent (div (dec axis) 2) =/ sibling ?: =(1 (mod axis 2)) (add axis 1) (sub axis 1) [(snag-as-digest:tip5 m.merk sibling) $(axis parent)] :: ++ snag-as-merk-proof |= [i=@ root=noun-digest:tip5 merk=mary] ^- merk-proof =/ mary-pat=mary (~(snag-as-mary ave merk) i) =/ pat (~(change-step ave mary-pat) 5) =/ merk-path=(list noun-digest:tip5) %+ turn (range len.array.pat) |= i=@ (snag-as-digest:tip5 pat i) [root merk-path] :: +$ merk-data [leaf=noun-digest:tip5 axis=@ p=merk-proof] ++ verify-merk-proof ~/ %verify-merk-proof |= [leaf=noun-digest:tip5 axis=@ merk-proof] ^- ? ?: =(0 axis) %.n |- ?: =(1 axis) &(=(root leaf) ?=(~ path)) ?~ path %.n =* sib i.path :: :: axis=2 when your parent is the root and you are the left child ?: =(2 axis) &(=(root (hash-ten-cell:tip5 leaf sib)) ?=(~ t.path)) :: :: axis=3 when your parent is the root and you are the right child ?: =(3 axis) &(=(root (hash-ten-cell:tip5 sib leaf)) ?=(~ t.path)) ?: =((mod axis 2) 0) $(axis (div axis 2), leaf (hash-ten-cell:tip5 leaf sib), path t.path) $(axis (div (dec axis) 2), leaf (hash-ten-cell:tip5 sib leaf), path t.path) :: -- --