blake3.sire (11287B)
1 ; Copyright 2023 The Plunder Authors 2 ; Use of this source code is governed by a BSD-style license that can be 3 ; found in the LICENSE file. 4 5 #### blake3 <- stew 6 7 :| sire 8 :| stew 9 :| w32 10 11 12 ;;; Types ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 13 14 #* # abstype CV 15 #* # abstype Chunk 16 #* # abstype HashState 17 #* # abstype Hasher 18 19 20 ;;; Definitions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 21 22 = (gulf f t) 23 | gen (sub (inc t) f) (add f) 24 25 ; Constants 26 b3OutLen=32 27 b3KeyLen=32 28 b3BlockLen=64 29 b3ChunkLen=1024 30 b3ChunkStart=(lsh 1 0) 31 b3ChunkEnd=(lsh 1 1) 32 b3Parent=(lsh 1 2) 33 b3Root=(lsh 1 3) 34 b3KeyedHash=(lsh 1 4) 35 b3DeriveKeyContext=(lsh 1 5) 36 b3DeriveKeyMaterial=(lsh 1 6) 37 38 = b3Iv 39 ++ 0x6A09E667 40 ++ 0xbb67ae85 41 ++ 0x3C6ef372 42 ++ 0xA54ff53a 43 ++ 0x510E527F 44 ++ 0x9B05688C 45 ++ 0x1F83D9ab 46 ++ 0x5be0cd19 47 48 = b3MsgPermutation 49 , 2 6 3 10 7 0 4 13 1 11 12 5 9 14 15 8 50 51 = (b3G S a b c d mx my) 52 @ S | put S a | add32 (add32 (get S a) (get S b)) mx 53 @ S | put S d | ror32 (xor32 (get S d) (get S a)) 16 54 @ S | put S c | add32 (get S c) (get S d) 55 @ S | put S b | ror32 (xor32 (get S b) (get S c)) 12 56 @ S | put S a | add32 (add32 (get S a) (get S b)) my 57 @ S | put S d | ror32 (xor32 (get S d) (get S a)) 8 58 @ S | put S c | add32 (get S c) (get S d) 59 @ S | put S b | ror32 (xor32 (get S b) (get S c)) 7 60 S 61 62 = (b3Round st m) 63 ; Mix the columns 64 @ st | b3G st 0 4 8 12 (get m 0) (get m 1) 65 @ st | b3G st 1 5 9 13 (get m 2) (get m 3) 66 @ st | b3G st 2 6 10 14 (get m 4) (get m 5) 67 @ st | b3G st 3 7 11 15 (get m 6) (get m 7) 68 ; 69 ; Mix the diagonals 70 @ st | b3G st 0 5 10 15 (get m 8) (get m 9) 71 @ st | b3G st 1 6 11 12 (get m 10) (get m 11) 72 @ st | b3G st 2 7 8 13 (get m 12) (get m 13) 73 @ st | b3G st 3 4 9 14 (get m 14) (get m 15) 74 st 75 76 = (b3Permute m) 77 : i < gen 16 78 | get m (get b3MsgPermutation i) 79 80 = (u32FromBytesLSB a b c d) 81 | add32 a 82 | add32 (lsh32 b 8) 83 | add32 (lsh32 c 16) 84 (lsh32 d 24) 85 86 > Row Word8 > Row Word32 87 = (bytesToWords bytes) 88 @ numBytes | len bytes 89 | if (mod numBytes 4) 90 | die {byte-row length not a multiple of 4} 91 : wix < gen (div numBytes 4) 92 @ bix (mul 4 wix) 93 | u32FromBytesLSB 94 (get bytes | bix) 95 (get bytes | add bix 1) 96 (get bytes | add bix 2) 97 (get bytes | add bix 3) 98 99 ; breaks a nat that represents a word into 100 ; its little-endian component bytes 101 (wordToBytes a)=(gen 4 i&(con 0xff (rsh a (mul 8 i)))) 102 103 ; Little Endian Byte order 104 > Row Word32 > Row Word8 105 (wordsToBytes wv)=(catMap wordToBytes wv) 106 107 > (Row8 Word32, Row16 Word32, Word64, Word32, Word32) 108 > Row16 Word32 109 = (b3Compress [chainingValue blockWords counter blockLen flags]) 110 @ st ++ get chainingValue 0 111 ++ get chainingValue 1 112 ++ get chainingValue 2 113 ++ get chainingValue 3 114 ++ get chainingValue 4 115 ++ get chainingValue 5 116 ++ get chainingValue 6 117 ++ get chainingValue 7 118 ++ get b3Iv 0 119 ++ get b3Iv 1 120 ++ get b3Iv 2 121 ++ get b3Iv 3 122 ++ chop32 counter 123 ++ chop32 (rsh counter 32) 124 ++ blockLen 125 ++ flags 126 @ block blockWords 127 @ st | b3Round st block ;;; round 1 128 @ block | b3Permute block 129 @ st | b3Round st block ;;; round 2 130 @ block | b3Permute block 131 @ st | b3Round st block ;;; round 3 132 @ block | b3Permute block 133 @ st | b3Round st block ;;; round 4 134 @ block | b3Permute block 135 @ st | b3Round st block ;;; round 5 136 @ block | b3Permute block 137 @ st | b3Round st block ;;; round 6 138 @ block | b3Permute block 139 @ st | b3Round st block ;;; round 7 140 ; 141 ^ _ 0 st 142 ? (loop i st) 143 | if (eql i 8) 144 st 145 @ st | put st i 146 | xor32 (get st (add i 8)) 147 | get st i 148 @ st | put st (add i 8) 149 | xor32 (get st (add i 8)) 150 | get chainingValue i 151 | loop (inc i) st 152 153 (first8words v)=(slice v 0 8) 154 155 = (b3OutputNew inChain blockWords counter len flags) 156 | (inChain, blockWords, counter, len, flags) 157 158 (b3OutputGetInputChainingValue o)=(get o 0) 159 (b3OutputGetBlockWords o)=(get o 1) 160 (b3OutputGetCounter o)=(get o 2) 161 (b3OutputGetBlockLen o)=(get o 3) 162 (b3OutputGetFlags o)=(get o 4) 163 164 = (b3OutputChainingValue output) 165 | first8words 166 | b3Compress output 167 168 ; Modification to the previous way the rust 169 ; version worked: the rust version took a 170 ; buffer called outSlice, which got filled 171 ; instead of returning a buffer of the 172 ; right size. 173 = (b3OutputRootOutputBytes o outSize) 174 @ outChunkLen 175 | mul 2 b3OutLen 176 @ wid 177 | div (roundUp outSize outChunkLen) outChunkLen 178 ^ cat (gen wid _) 179 & outputBlockCounter 180 @ words 181 | b3Compress 182 ++ b3OutputGetInputChainingValue o 183 ++ b3OutputGetBlockWords o 184 ++ outputBlockCounter 185 ++ b3OutputGetBlockLen o 186 ++ or32 (b3OutputGetFlags o) b3Root 187 @ usedBytes | mul outChunkLen outputBlockCounter 188 @ remBytes | sub outSize usedBytes 189 @ need | min outChunkLen remBytes 190 | take need (wordsToBytes words) 191 192 193 ; = ChunkState 194 ; , chainingVal 195 ; , chunkCounter 196 ; , block 197 ; , blockLen 198 ; , blocksCompressed 199 ; , flags 200 201 (b3ChunkstGetChainingVal c)=(get c 0) 202 (b3ChunkstGetChunkCounter c)=(get c 1) 203 (b3ChunkstGetBlock c)=(get c 2) 204 (b3ChunkstGetBlockLen c)=(get c 3) 205 (b3ChunkstGetBlocksCompressed c)=(get c 4) 206 (b3ChunkstGetFlags c)=(get c 5) 207 (b3ChunkstPutChainingVal c)=(put c 0) 208 (b3ChunkstPutChunkCounter c)=(put c 1) 209 (b3ChunkstPutBlock c)=(put c 2) 210 (b3ChunkstPutBlockLen c)=(put c 3) 211 (b3ChunkstPutBlocksCompressed c)=(put c 4) 212 (b3ChunkstPutFlags c)=(put c 5) 213 214 = (b3ChunkstNew keyWords chunkCounter flags) 215 ++ keyWords 216 ++ chunkCounter 217 ++ rep 0 b3BlockLen 218 ++ 0 219 ++ 0 220 ++ flags 221 222 = (b3ChunkstLen c) 223 | add (b3ChunkstGetBlockLen c) 224 | mul b3BlockLen 225 | b3ChunkstGetBlocksCompressed c 226 227 = (b3ChunkstStartFlag c) 228 | ifz (b3ChunkstGetBlocksCompressed c) 229 * b3ChunkStart 230 * 0 231 232 > Chunk > Row u8 > Chunk 233 = (b3ChunkstUpdate c input) 234 | ifz (len input) c 235 @ c | if 236 * neq b3BlockLen (b3ChunkstGetBlockLen c) 237 * c 238 ; If the block buffer is full, compress it and clear it. 239 @ blockWords 240 | bytesToWords 241 | b3ChunkstGetBlock c 242 @ c | b3ChunkstPutChainingVal c 243 | first8words 244 | b3Compress 245 ++ b3ChunkstGetChainingVal c 246 ++ blockWords 247 ++ b3ChunkstGetChunkCounter c 248 ++ b3BlockLen 249 ++ | or32 250 * b3ChunkstGetFlags c 251 * b3ChunkstStartFlag c 252 @ c | b3ChunkstPutBlocksCompressed c 253 | inc (b3ChunkstGetBlocksCompressed c) 254 @ c | b3ChunkstPutBlock c 255 | rep 0 b3BlockLen 256 @ c | b3ChunkstPutBlockLen c 0 257 c 258 @ want | sub b3BlockLen (b3ChunkstGetBlockLen c) 259 @ need | min want (len input) 260 @ c | b3ChunkstPutBlock c 261 : i < gen (len | b3ChunkstGetBlock c) 262 @ blockLen | b3ChunkstGetBlockLen c 263 | if (lth i blockLen || gte i (add need blockLen)) 264 * get (b3ChunkstGetBlock c) i 265 * get input (sub i blockLen) 266 @ c | b3ChunkstPutBlockLen c 267 | add (b3ChunkstGetBlockLen c) need 268 | b3ChunkstUpdate c (drop need input) 269 270 = (b3ChunkstOutput c) 271 @ blockWords 272 | bytesToWords | b3ChunkstGetBlock c 273 | b3OutputNew 274 * b3ChunkstGetChainingVal c 275 * blockWords 276 * b3ChunkstGetChunkCounter c 277 * b3ChunkstGetBlockLen c 278 | or32 279 * or32 (b3ChunkstGetFlags c) (b3ChunkstStartFlag c) 280 * b3ChunkEnd 281 282 = (b3ParentOutput lChildCv rChildCv keyWords flags) 283 @ blockWords 284 | weld (take 8 lChildCv) (take 8 rChildCv) 285 | b3OutputNew 286 * keyWords 287 * blockWords 288 * 0 289 * b3BlockLen 290 * or32 b3Parent flags 291 292 = (b3ParentCv lChildCv rChildCv keyWords flags) 293 | b3OutputChainingValue 294 | b3ParentOutput 295 * lChildCv 296 * rChildCv 297 * keyWords 298 * flags 299 300 ; (Modifying cvStack,cvStackLen to just use 301 ; a list in this port.) 302 ; 303 ; = Hasher 304 ; , chunkState/ChunkState 305 ; , keyWords/(u32*8) 306 ; , cvStack/(List) 307 ; , flags 308 309 (b3HasherGetChunkst h)=(get h 0) 310 (b3HasherGetKeyWords h)=(get h 1) 311 (b3HasherGetCvStack h)=(get h 2) 312 (b3HasherGetFlags h)=(get h 3) 313 314 (b3HasherPutChunkst h st)=(put h 0 st) 315 (b3HasherPutCvStack h cv)=(put h 2 cv) 316 317 = (b3HasherNewInternal keyWords flags) 318 | ifNot (eql 8 | len keyWords) 319 | die {Incorrect length of keyWords} 320 ++ b3ChunkstNew keyWords 0 flags 321 ++ keyWords 322 ++ NIL 323 ++ flags 324 325 = b3HasherNew 326 | b3HasherNewInternal b3Iv 0 327 328 ; Punting: newKeyed, newDeriveKey. 329 330 > h > CV > h 331 = (b3HasherPushStack h cv) 332 @ st | CONS cv (b3HasherGetCvStack h) 333 | b3HasherPutCvStack h st 334 335 > HashState > [CV HashState] 336 = (b3HasherPopStack hSt) 337 | listCase (b3HasherGetCvStack hSt) 338 | die } Trying to pop empty stack 339 & (top res) 340 | (top, b3HasherPutCvStack hSt res) 341 342 ; "Section 5.1.2 of the blake3 spec explains 343 ; this algorithm in more detail." 344 ; 345 ; Returns h 346 = | b3HasherAddChunkChainingValue 347 h 348 newCv 349 totalChunks 350 ^ _ h newCv totalChunks 351 ? (go h newCv totalChunks) 352 | ifNot (and32 totalChunks 1) 353 @ [leftCv h] 354 | b3HasherPopStack h 355 @ newCv 356 | b3ParentCv 357 * leftCv 358 * newCv 359 * b3HasherGetKeyWords h 360 * b3HasherGetFlags h 361 @ totalChunks 362 | rsh totalChunks 1 363 | go h newCv totalChunks 364 | b3HasherPushStack h newCv 365 366 = (b3HasherUpdate h input) 367 @ final 368 & (h input) 369 @ want | sub b3ChunkLen 370 | b3ChunkstLen 371 | b3HasherGetChunkst h 372 @ need | min want (len input) 373 @ temp | b3ChunkstUpdate 374 * b3HasherGetChunkst h 375 * take need input 376 @ h | b3HasherPutChunkst h temp 377 @ input | drop need input 378 | b3HasherUpdate h input 379 | ifNot (len input) h 380 | if | neq b3ChunkLen 381 | b3ChunkstLen 382 | b3HasherGetChunkst h 383 | final h input 384 @ chunkCv 385 | b3OutputChainingValue 386 | b3ChunkstOutput 387 | b3HasherGetChunkst h 388 @ totalChunks 389 | inc 390 | b3ChunkstGetChunkCounter 391 | b3HasherGetChunkst h 392 @ h | b3HasherAddChunkChainingValue 393 * h 394 * chunkCv 395 * totalChunks 396 @ h | b3HasherPutChunkst h 397 | b3ChunkstNew 398 * b3HasherGetKeyWords h 399 * totalChunks 400 * b3HasherGetFlags h 401 | final h input 402 403 > Hasher > Nat > Row Word8 404 = (b3Finalize h outHashSize) 405 @ out (b3ChunkstOutput | b3HasherGetChunkst h) 406 ^ _ out (b3HasherGetCvStack h) 407 ? (go output stack) 408 | listCase stack 409 | b3OutputRootOutputBytes output outHashSize 410 & (top res) 411 @ output 412 | b3ParentOutput 413 * top 414 * b3OutputChainingValue output 415 * b3HasherGetKeyWords h 416 * b3HasherGetFlags h 417 | go output res 418 419 ; One-function convenience method that 420 ; handles entire operation for one row. 421 422 = (blake3_row byt) 423 | b3Finalize (b3HasherUpdate b3HasherNew byt) 32 424 425 = (_Blake3 x) 426 ^ bytesBar (b3Finalize _ 32) 427 ^ listFoldl _ b3HasherNew (barTreeToList x) 428 | (h x)&(b3HasherUpdate h barBytes-x) 429 430 blake3=_Blake3 431 432 433 ;;; Tests ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 434 435 =?= | barCat 436 ++ x#7470ea5654831e01ffc04ee0e43a32fb 437 ++ x#90227162dc0faaa14f9627d8f5c718f7 438 | blake3 b#fdsafdsa 439 440 = testData 441 ^ _ (barGen 4096 id) 3 442 ? (loop remaining size) 443 | if (barIsEmpty remaining) NIL 444 | CONS (barTake size remaining) 445 | loop (barDrop size remaining) (mul 2 size) 446 447 =?= | blake3 testData 448 | blake3 (barFlat testData) 449 450 !! | listAllEql 451 ~~ pinItem blake3 b#foobarbaz 452 ~~ pinItem blake3 ~[b#foo b#bar b#baz] 453 ~~ pinItem blake3 (1 b#baz b#bar b#foo) 454 ~~ pinItem blake3 (add (1 2 b#baz b#bar (0 b#foo))) 455 ~~ blake3 b#foobarbaz 456 ~~ blake3 ~[b#foo b#bar b#baz] 457 ~~ blake3 (1 b#baz b#bar b#foo) 458 ~~ blake3 (add (1 2 b#baz b#bar (0 b#foo))) 459 460 =?= | blake3 [testData b#foo] 461 | blake3 (barFlat [testData b#foo]) 462 463 =?= | blake3 [[b#foo testData b#bar] b#baz] 464 | blake3 (barFlat [[b#foo testData b#bar] b#baz]) 465 466 467 ;;; Exports ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 468 469 ^-^ blake3 470 ^-^ blake3_row