+812

PDSharp.Core/Mst.fs

reviewed

··· 1 1 + namespace PDSharp.Core 2 2 + 3 3 + open System 4 4 + open System.Collections.Generic 5 5 + open System.Formats.Cbor 6 6 + 7 7 + module Mst = 8 8 + type MstEntry = { 9 9 + PrefixLen : int 10 10 + KeySuffix : string 11 11 + Value : Cid 12 12 + Tree : Cid option 13 13 + } 14 14 + 15 15 + type MstNode = { Left : Cid option; Entries : MstEntry list } 16 16 + 17 17 + /// Layer Calculation 18 18 + let layer (key : string) : int = 19 19 + let hash = Crypto.sha256Str key 20 20 + let mutable zeros = 0 21 21 + let mutable i = 0 22 22 + let mutable found = false 23 23 + 24 24 + while i < hash.Length && not found do 25 25 + let b = hash.[i] 26 26 + 27 27 + if b = 0uy then 28 28 + zeros <- zeros + 8 29 29 + i <- i + 1 30 30 + else 31 31 + let mutable mask = 0x80uy 32 32 + 33 33 + while b &&& mask = 0uy do 34 34 + zeros <- zeros + 1 35 35 + mask <- mask >>> 1 36 36 + 37 37 + found <- true 38 38 + 39 39 + zeros / 2 40 40 + 41 41 + let entryToCborObj (e : MstEntry) : obj = 42 42 + let arr = Array.zeroCreate<obj> 4 43 43 + arr.[0] <- e.PrefixLen :> obj 44 44 + arr.[1] <- e.KeySuffix :> obj 45 45 + arr.[2] <- e.Value :> obj 46 46 + 47 47 + arr.[3] <- 48 48 + match e.Tree with 49 49 + | Some c -> c :> obj 50 50 + | None -> null 51 51 + 52 52 + arr :> obj 53 53 + 54 54 + let nodeToCborObj (node : MstNode) : obj = 55 55 + let arr = Array.zeroCreate<obj> 2 56 56 + 57 57 + arr.[0] <- 58 58 + match node.Left with 59 59 + | Some c -> c :> obj 60 60 + | None -> null 61 61 + 62 62 + let entriesArr = node.Entries |> List.map entryToCborObj |> Seq.toArray 63 63 + arr.[1] <- entriesArr :> obj 64 64 + arr :> obj 65 65 + 66 66 + let serialize (node : MstNode) : byte[] = nodeToCborObj node |> DagCbor.encode 67 67 + 68 68 + let readCid (reader : CborReader) = 69 69 + let tag = reader.ReadTag() 70 70 + let tag42 = LanguagePrimitives.EnumOfValue<uint64, CborTag>(42UL) 71 71 + 72 72 + if tag <> tag42 then 73 73 + failwith "Expected CID tag 42" 74 74 + 75 75 + let bytes = reader.ReadByteString() 76 76 + 77 77 + if bytes.Length > 0 && bytes.[0] = 0x00uy then 78 78 + let raw = Array.zeroCreate<byte> (bytes.Length - 1) 79 79 + Array.Copy(bytes, 1, raw, 0, raw.Length) 80 80 + Cid raw 81 81 + else 82 82 + Cid bytes 83 83 + 84 84 + let deserialize (data : byte[]) : MstNode = 85 85 + let reader = new CborReader(data.AsMemory(), CborConformanceMode.Strict) 86 86 + let len = reader.ReadStartArray() 87 87 + 88 88 + if len.HasValue && len.Value <> 2 then 89 89 + failwith "MST node must be array of length 2" 90 90 + 91 91 + let left = 92 92 + match reader.PeekState() with 93 93 + | CborReaderState.Null -> 94 94 + reader.ReadNull() 95 95 + None 96 96 + | _ -> Some(readCid reader) 97 97 + 98 98 + let entriesLen = reader.ReadStartArray() 99 99 + let mutable entries = [] 100 100 + 101 101 + let count = 102 102 + if entriesLen.HasValue then 103 103 + entriesLen.Value 104 104 + else 105 105 + Int32.MaxValue 106 106 + 107 107 + let mutable i = 0 108 108 + 109 109 + while i < count && reader.PeekState() <> CborReaderState.EndArray do 110 110 + let entryLen = reader.ReadStartArray() 111 111 + 112 112 + if entryLen.HasValue && entryLen.Value <> 4 then 113 113 + failwith "MST entry must be array of length 4" 114 114 + 115 115 + let p = reader.ReadInt32() 116 116 + let k = reader.ReadTextString() 117 117 + let v = readCid reader 118 118 + 119 119 + let t = 120 120 + match reader.PeekState() with 121 121 + | CborReaderState.Null -> 122 122 + reader.ReadNull() 123 123 + None 124 124 + | _ -> Some(readCid reader) 125 125 + 126 126 + reader.ReadEndArray() 127 127 + 128 128 + entries <- entries @ [ { PrefixLen = p; KeySuffix = k; Value = v; Tree = t } ] 129 129 + i <- i + 1 130 130 + 131 131 + reader.ReadEndArray() 132 132 + reader.ReadEndArray() 133 133 + { Left = left; Entries = entries } 134 134 + 135 135 + let compareKeys (a : string) (b : string) : int = 136 136 + let bytesA = System.Text.Encoding.UTF8.GetBytes(a) 137 137 + let bytesB = System.Text.Encoding.UTF8.GetBytes(b) 138 138 + let len = min bytesA.Length bytesB.Length 139 139 + let mutable res = 0 140 140 + let mutable i = 0 141 141 + 142 142 + while res = 0 && i < len do 143 143 + res <- bytesA.[i].CompareTo(bytesB.[i]) 144 144 + i <- i + 1 145 145 + 146 146 + if res <> 0 then 147 147 + res 148 148 + else 149 149 + bytesA.Length.CompareTo bytesB.Length 150 150 + 151 151 + type NodeLoader = Cid -> Async<MstNode option> 152 152 + type NodePersister = MstNode -> Async<Cid> 153 153 + 154 154 + let storeNode (persister : NodePersister) (node : MstNode) : Async<Cid> = persister node 155 155 + 156 156 + let rec get (loader : NodeLoader) (node : MstNode) (key : string) (prevKey : string) : Async<Cid option> = async { 157 157 + let mutable currentKey = prevKey 158 158 + let mutable foundEntry : MstEntry option = None 159 159 + let mutable nextTree : Cid option = node.Left 160 160 + let mutable stop = false 161 161 + let mutable i = 0 162 162 + 163 163 + while not stop && i < node.Entries.Length do 164 164 + let e = node.Entries.[i] 165 165 + 166 166 + let prefix = 167 167 + if e.PrefixLen > currentKey.Length then 168 168 + currentKey 169 169 + else 170 170 + currentKey.Substring(0, e.PrefixLen) 171 171 + 172 172 + let fullKey = prefix + e.KeySuffix 173 173 + let cmp = compareKeys key fullKey 174 174 + 175 175 + if cmp = 0 then 176 176 + foundEntry <- Some e 177 177 + stop <- true 178 178 + elif cmp < 0 then 179 179 + stop <- true 180 180 + else 181 181 + nextTree <- e.Tree 182 182 + currentKey <- fullKey 183 183 + i <- i + 1 184 184 + 185 185 + match foundEntry with 186 186 + | Some e -> return Some e.Value 187 187 + | None -> 188 188 + match nextTree with 189 189 + | None -> return None 190 190 + | Some cid -> 191 191 + let! child = loader cid 192 192 + 193 193 + match child with 194 194 + | Some cNode -> return! get loader cNode key currentKey 195 195 + | None -> return None 196 196 + } 197 197 + 198 198 + let sharedPrefixLen (a : string) (b : string) = 199 199 + let len = min a.Length b.Length 200 200 + let mutable i = 0 201 201 + 202 202 + while i < len && a.[i] = b.[i] do 203 203 + i <- i + 1 204 204 + 205 205 + i 206 206 + 207 207 + let nodeLayer (node : MstNode) (prevKey : string) = 208 208 + match node.Entries with 209 209 + | [] -> -1 210 210 + | first :: _ -> 211 211 + let prefix = 212 212 + if first.PrefixLen > prevKey.Length then 213 213 + prevKey 214 214 + else 215 215 + prevKey.Substring(0, first.PrefixLen) 216 216 + 217 217 + let fullKey = prefix + first.KeySuffix 218 218 + layer fullKey 219 219 + 220 220 + /// Splits a node around a key (which is assumed to be higher layer than any in the node). 221 221 + /// 222 222 + /// Returns (LeftNode, RightNode). 223 223 + let rec split 224 224 + (loader : NodeLoader) 225 225 + (persister : NodePersister) 226 226 + (node : MstNode) 227 227 + (key : string) 228 228 + (prevKey : string) 229 229 + : Async<MstNode * MstNode> = 230 230 + async { 231 231 + let mutable splitIdx = -1 232 232 + let mutable found = false 233 233 + let mutable currentKey = prevKey 234 234 + let mutable i = 0 235 235 + let entries = node.Entries 236 236 + let mutable splitPrevKey = prevKey 237 237 + 238 238 + while i < entries.Length && not found do 239 239 + let e = entries.[i] 240 240 + 241 241 + let prefix = 242 242 + if e.PrefixLen > currentKey.Length then 243 243 + currentKey 244 244 + else 245 245 + currentKey.Substring(0, e.PrefixLen) 246 246 + 247 247 + let fullKey = prefix + e.KeySuffix 248 248 + 249 249 + if compareKeys key fullKey < 0 then 250 250 + splitIdx <- i 251 251 + found <- true 252 252 + else 253 253 + currentKey <- fullKey 254 254 + splitPrevKey <- currentKey 255 255 + i <- i + 1 256 256 + 257 257 + let childCidToSplit = 258 258 + if found then 259 259 + if splitIdx = 0 then 260 260 + node.Left 261 261 + else 262 262 + entries.[splitIdx - 1].Tree 263 263 + else if entries.Length = 0 then 264 264 + node.Left 265 265 + else 266 266 + entries.[entries.Length - 1].Tree 267 267 + 268 268 + let! (lChild, rChild) = async { 269 269 + match childCidToSplit with 270 270 + | None -> return ({ Left = None; Entries = [] }, { Left = None; Entries = [] }) 271 271 + | Some cid -> 272 272 + let! childNodeOpt = loader cid 273 273 + 274 274 + match childNodeOpt with 275 275 + | None -> return ({ Left = None; Entries = [] }, { Left = None; Entries = [] }) 276 276 + | Some childNode -> return! split loader persister childNode key currentKey 277 277 + } 278 278 + 279 279 + let persistOrNone (n : MstNode) = async { 280 280 + if n.Entries.IsEmpty && n.Left.IsNone then 281 281 + return None 282 282 + else 283 283 + let! c = persister n 284 284 + return Some c 285 285 + } 286 286 + 287 287 + let! lCid = persistOrNone lChild 288 288 + let! rCid = persistOrNone rChild 289 289 + let leftEntries = if found then entries |> List.take splitIdx else entries 290 290 + 291 291 + let newLeftEntries = 292 292 + if leftEntries.IsEmpty then 293 293 + [] 294 294 + else 295 295 + let last = leftEntries.[leftEntries.Length - 1] 296 296 + let newLast = { last with Tree = lCid } 297 297 + (leftEntries |> List.take (leftEntries.Length - 1)) @ [ newLast ] 298 298 + 299 299 + let leftNode = 300 300 + if leftEntries.IsEmpty then 301 301 + { Left = lCid; Entries = [] } 302 302 + else 303 303 + { Left = node.Left; Entries = newLeftEntries } 304 304 + 305 305 + let rightEntries = if found then entries |> List.skip splitIdx else [] 306 306 + 307 307 + let newRightEntries = 308 308 + match rightEntries with 309 309 + | [] -> [] 310 310 + | first :: rest -> 311 311 + let firstFullKey = 312 312 + let prefix = 313 313 + if first.PrefixLen > currentKey.Length then 314 314 + currentKey 315 315 + else 316 316 + currentKey.Substring(0, first.PrefixLen) 317 317 + 318 318 + prefix + first.KeySuffix 319 319 + 320 320 + let newP = sharedPrefixLen key firstFullKey 321 321 + let newSuffix = firstFullKey.Substring(newP) 322 322 + let newFirst = { first with PrefixLen = newP; KeySuffix = newSuffix } 323 323 + newFirst :: rest 324 324 + 325 325 + let rightNode = { Left = rCid; Entries = newRightEntries } 326 326 + return (leftNode, rightNode) 327 327 + } 328 328 + 329 329 + let rec put 330 330 + (loader : NodeLoader) 331 331 + (persister : NodePersister) 332 332 + (node : MstNode) 333 333 + (key : string) 334 334 + (value : Cid) 335 335 + (prevKey : string) 336 336 + : Async<MstNode> = 337 337 + async { 338 338 + let kLayer = layer key 339 339 + 340 340 + let nLayer = 341 341 + match node.Entries with 342 342 + | [] -> -1 343 343 + | first :: _ -> 344 344 + let prefix = 345 345 + if first.PrefixLen > prevKey.Length then 346 346 + prevKey 347 347 + else 348 348 + prevKey.Substring(0, first.PrefixLen) 349 349 + 350 350 + let fullKey = prefix + first.KeySuffix 351 351 + layer fullKey 352 352 + 353 353 + if kLayer > nLayer then 354 354 + let! (lNode, rNode) = split loader persister node key prevKey 355 355 + 356 356 + let persistOrNone (n : MstNode) = async { 357 357 + if n.Entries.IsEmpty && n.Left.IsNone then 358 358 + return None 359 359 + else 360 360 + let! c = persister n 361 361 + return Some c 362 362 + } 363 363 + 364 364 + let! lCid = persistOrNone lNode 365 365 + let! rCid = persistOrNone rNode 366 366 + 367 367 + let p = sharedPrefixLen prevKey key 368 368 + let suffix = key.Substring(p) 369 369 + 370 370 + return { 371 371 + Left = lCid 372 372 + Entries = [ 373 373 + { 374 374 + PrefixLen = p 375 375 + KeySuffix = suffix 376 376 + Value = value 377 377 + Tree = rCid 378 378 + } 379 379 + ] 380 380 + } 381 381 + 382 382 + elif kLayer < nLayer then 383 383 + let mutable nextCid = node.Left 384 384 + let mutable currentKey = prevKey 385 385 + let mutable found = false 386 386 + let mutable i = 0 387 387 + 388 388 + let entries = node.Entries 389 389 + let mutable childIdx = -1 390 390 + 391 391 + while i < entries.Length && not found do 392 392 + let e = entries.[i] 393 393 + 394 394 + let prefix = 395 395 + if e.PrefixLen > currentKey.Length then 396 396 + currentKey 397 397 + else 398 398 + currentKey.Substring(0, e.PrefixLen) 399 399 + 400 400 + let fullKey = prefix + e.KeySuffix 401 401 + 402 402 + if compareKeys key fullKey < 0 then 403 403 + found <- true 404 404 + else 405 405 + childIdx <- i 406 406 + nextCid <- e.Tree 407 407 + currentKey <- fullKey 408 408 + i <- i + 1 409 409 + 410 410 + let! childNode = 411 411 + match nextCid with 412 412 + | Some c -> loader c 413 413 + | None -> async { return Some { Left = None; Entries = [] } } 414 414 + 415 415 + match childNode with 416 416 + | None -> return failwith "Failed to load child node" 417 417 + | Some cn -> 418 418 + let! newChildNode = put loader persister cn key value currentKey 419 419 + let! newChildCid = persister newChildNode 420 420 + 421 421 + if childIdx = -1 then 422 422 + return { node with Left = Some newChildCid } 423 423 + else 424 424 + return { 425 425 + node with 426 426 + Entries = 427 427 + entries 428 428 + |> List.mapi (fun idx x -> 429 429 + if idx = childIdx then 430 430 + { entries.[childIdx] with Tree = Some newChildCid } 431 431 + else 432 432 + x) 433 433 + } 434 434 + 435 435 + else 436 436 + let mutable insertIdx = -1 437 437 + let mutable found = false 438 438 + let mutable currentKey = prevKey 439 439 + let mutable i = 0 440 440 + let mutable targetChildCid = None 441 441 + let mutable childPrevKey = prevKey 442 442 + 443 443 + let fullKeysCache = new List<string>() 444 444 + 445 445 + while i < node.Entries.Length && not found do 446 446 + let e = node.Entries.[i] 447 447 + 448 448 + let prefix = 449 449 + if e.PrefixLen > currentKey.Length then 450 450 + currentKey 451 451 + else 452 452 + currentKey.Substring(0, e.PrefixLen) 453 453 + 454 454 + let fullKey = prefix + e.KeySuffix 455 455 + fullKeysCache.Add(fullKey) 456 456 + 457 457 + let cmp = compareKeys key fullKey 458 458 + 459 459 + if cmp = 0 then 460 460 + insertIdx <- i 461 461 + found <- true 462 462 + elif cmp < 0 then 463 463 + insertIdx <- i 464 464 + targetChildCid <- if i = 0 then node.Left else node.Entries.[i - 1].Tree 465 465 + childPrevKey <- currentKey 466 466 + found <- true 467 467 + else 468 468 + currentKey <- fullKey 469 469 + i <- i + 1 470 470 + 471 471 + if not found then 472 472 + insertIdx <- node.Entries.Length 473 473 + 474 474 + targetChildCid <- 475 475 + if node.Entries.Length = 0 then 476 476 + node.Left 477 477 + else 478 478 + node.Entries.[node.Entries.Length - 1].Tree 479 479 + 480 480 + childPrevKey <- currentKey 481 481 + 482 482 + let entries = node.Entries 483 483 + 484 484 + if found && compareKeys key fullKeysCache.[insertIdx] = 0 then 485 485 + let e = entries.[insertIdx] 486 486 + let newE = { e with Value = value } 487 487 + 488 488 + let newEntries = 489 489 + entries |> List.mapi (fun idx x -> if idx = insertIdx then newE else x) 490 490 + 491 491 + return { node with Entries = newEntries } 492 492 + else 493 493 + let! (lChild, rChild) = async { 494 494 + match targetChildCid with 495 495 + | None -> return { Left = None; Entries = [] }, { Left = None; Entries = [] } 496 496 + | Some cid -> 497 497 + let! cOpt = loader cid 498 498 + 499 499 + match cOpt with 500 500 + | None -> return { Left = None; Entries = [] }, { Left = None; Entries = [] } 501 501 + | Some c -> return! split loader persister c key childPrevKey 502 502 + } 503 503 + 504 504 + let persistOrNone (n : MstNode) = async { 505 505 + if n.Entries.IsEmpty && n.Left.IsNone then 506 506 + return None 507 507 + else 508 508 + let! c = persister n 509 509 + return Some c 510 510 + } 511 511 + 512 512 + let! lCid = persistOrNone lChild 513 513 + let! rCid = persistOrNone rChild 514 514 + 515 515 + let beforeEntries = 516 516 + if insertIdx = 0 then 517 517 + [] 518 518 + else 519 519 + let prevE = entries.[insertIdx - 1] 520 520 + let newPrevE = { prevE with Tree = lCid } 521 521 + (entries |> List.take (insertIdx - 1)) @ [ newPrevE ] 522 522 + 523 523 + let newLeft = if insertIdx = 0 then lCid else node.Left 524 524 + let getFullKey idx = fullKeysCache.[idx] 525 525 + let p = sharedPrefixLen childPrevKey key 526 526 + let suffix = key.Substring(p) 527 527 + 528 528 + let newEntry = { 529 529 + PrefixLen = p 530 530 + KeySuffix = suffix 531 531 + Value = value 532 532 + Tree = rCid 533 533 + } 534 534 + 535 535 + let afterEntries = 536 536 + if insertIdx >= entries.Length then 537 537 + [] 538 538 + else 539 539 + let first = entries.[insertIdx] 540 540 + let firstFullKey = getFullKey insertIdx 541 541 + 542 542 + let newP = sharedPrefixLen key firstFullKey 543 543 + let newS = firstFullKey.Substring(newP) 544 544 + let newFirst = { first with PrefixLen = newP; KeySuffix = newS } 545 545 + 546 546 + [ newFirst ] @ (entries |> List.skip (insertIdx + 1)) 547 547 + 548 548 + let newEntries = beforeEntries @ [ newEntry ] @ afterEntries 549 549 + 550 550 + return { Left = newLeft; Entries = newEntries } 551 551 + } 552 552 + 553 553 + // --- Merge Operation --- 554 554 + let rec merge 555 555 + (loader : NodeLoader) 556 556 + (persister : NodePersister) 557 557 + (leftCid : Cid option) 558 558 + (rightCid : Cid option) 559 559 + (prevKey : string) 560 560 + : Async<MstNode> = 561 561 + async { 562 562 + match leftCid, rightCid with 563 563 + | None, None -> return { Left = None; Entries = [] } 564 564 + | Some l, None -> 565 565 + let! n = loader l 566 566 + return n |> Option.defaultValue { Left = None; Entries = [] } 567 567 + | None, Some r -> 568 568 + let! n = loader r 569 569 + return n |> Option.defaultValue { Left = None; Entries = [] } 570 570 + | Some l, Some r -> 571 571 + let! lNodeOpt = loader l 572 572 + let! rNodeOpt = loader r 573 573 + let lNode = lNodeOpt |> Option.defaultValue { Left = None; Entries = [] } 574 574 + let rNode = rNodeOpt |> Option.defaultValue { Left = None; Entries = [] } 575 575 + 576 576 + let lLayer = nodeLayer lNode prevKey 577 577 + let mutable current = prevKey 578 578 + 579 579 + for e in lNode.Entries do 580 580 + let p = 581 581 + if e.PrefixLen > current.Length then 582 582 + current 583 583 + else 584 584 + current.Substring(0, e.PrefixLen) 585 585 + 586 586 + current <- p + e.KeySuffix 587 587 + 588 588 + let rightPrevKey = current 589 589 + 590 590 + let realLLayer = nodeLayer lNode prevKey 591 591 + let realRLayer = nodeLayer rNode rightPrevKey 592 592 + 593 593 + if realLLayer > realRLayer then 594 594 + match lNode.Entries with 595 595 + | [] -> return! merge loader persister lNode.Left rightCid prevKey 596 596 + | entries -> 597 597 + let lastIdx = entries.Length - 1 598 598 + let lastEntry = entries.[lastIdx] 599 599 + 600 600 + let! mergedChild = merge loader persister lastEntry.Tree rightCid rightPrevKey 601 601 + let! mergedCid = persister mergedChild 602 602 + 603 603 + let newEntry = { lastEntry with Tree = Some mergedCid } 604 604 + let newEntries = (entries |> List.take lastIdx) @ [ newEntry ] 605 605 + return { lNode with Entries = newEntries } 606 606 + 607 607 + elif realRLayer > realLLayer then 608 608 + match rNode.Entries with 609 609 + | [] -> return! merge loader persister leftCid rNode.Left prevKey 610 610 + | _ -> 611 611 + let! mergedChild = merge loader persister leftCid rNode.Left prevKey 612 612 + let! mergedCid = persister mergedChild 613 613 + 614 614 + return { rNode with Left = Some mergedCid } 615 615 + 616 616 + else 617 617 + let boundaryL = 618 618 + match lNode.Entries with 619 619 + | [] -> lNode.Left 620 620 + | es -> es.[es.Length - 1].Tree 621 621 + 622 622 + let boundaryR = rNode.Left 623 623 + 624 624 + let! mergedBoundaryNode = merge loader persister boundaryL boundaryR rightPrevKey 625 625 + let! mergedBoundaryCid = persister mergedBoundaryNode 626 626 + 627 627 + let newEntries = 628 628 + match lNode.Entries with 629 629 + | [] -> rNode.Entries 630 630 + | lEntries -> 631 631 + let lastIdx = lEntries.Length - 1 632 632 + let lastE = lEntries.[lastIdx] 633 633 + let newLastE = { lastE with Tree = Some mergedBoundaryCid } 634 634 + (lEntries |> List.take lastIdx) @ [ newLastE ] @ rNode.Entries 635 635 + 636 636 + let newLeft = 637 637 + if lNode.Entries.IsEmpty then 638 638 + Some mergedBoundaryCid 639 639 + else 640 640 + lNode.Left 641 641 + 642 642 + return { Left = newLeft; Entries = newEntries } 643 643 + } 644 644 + 645 645 + let rec delete 646 646 + (loader : NodeLoader) 647 647 + (persister : NodePersister) 648 648 + (node : MstNode) 649 649 + (key : string) 650 650 + (prevKey : string) 651 651 + : Async<MstNode option> = 652 652 + async { 653 653 + let mutable currentKey = prevKey 654 654 + let mutable foundIdx = -1 655 655 + let mutable nextTreeIdx = -1 656 656 + let mutable i = 0 657 657 + let mutable found = false 658 658 + 659 659 + while i < node.Entries.Length && not found do 660 660 + let e = node.Entries.[i] 661 661 + 662 662 + let prefix = 663 663 + if e.PrefixLen > currentKey.Length then 664 664 + currentKey 665 665 + else 666 666 + currentKey.Substring(0, e.PrefixLen) 667 667 + 668 668 + let fullKey = prefix + e.KeySuffix 669 669 + 670 670 + let cmp = compareKeys key fullKey 671 671 + 672 672 + if cmp = 0 then 673 673 + foundIdx <- i 674 674 + found <- true 675 675 + elif cmp < 0 then 676 676 + found <- true 677 677 + nextTreeIdx <- i - 1 678 678 + else 679 679 + currentKey <- fullKey 680 680 + i <- i + 1 681 681 + 682 682 + if not found then 683 683 + nextTreeIdx <- node.Entries.Length - 1 684 684 + 685 685 + if foundIdx <> -1 then 686 686 + let e = node.Entries.[foundIdx] 687 687 + 688 688 + let leftChildCid = 689 689 + if foundIdx = 0 then 690 690 + node.Left 691 691 + else 692 692 + node.Entries.[foundIdx - 1].Tree 693 693 + 694 694 + let rightChildCid = e.Tree 695 695 + 696 696 + let mergePrevKey = if foundIdx = 0 then prevKey else currentKey 697 697 + 698 698 + let! mergedChildNode = merge loader persister leftChildCid rightChildCid mergePrevKey 699 699 + let! mergedChildCid = persister mergedChildNode 700 700 + 701 701 + let newEntries = 702 702 + if foundIdx = 0 then 703 703 + let rest = node.Entries |> List.skip 1 704 704 + 705 705 + match rest with 706 706 + | [] -> [] 707 707 + | first :: rs -> 708 708 + let firstFullKey = 709 709 + let oldP = 710 710 + if first.PrefixLen > key.Length then 711 711 + key 712 712 + else 713 713 + key.Substring(0, first.PrefixLen) 714 714 + 715 715 + oldP + first.KeySuffix 716 716 + 717 717 + let newP = sharedPrefixLen prevKey firstFullKey 718 718 + let newSuffix = firstFullKey.Substring(newP) 719 719 + let newFirst = { first with PrefixLen = newP; KeySuffix = newSuffix } 720 720 + newFirst :: rs 721 721 + else 722 722 + let before = node.Entries |> List.take (foundIdx - 1) 723 723 + let prevE = node.Entries.[foundIdx - 1] 724 724 + let newPrevE = { prevE with Tree = Some mergedChildCid } 725 725 + 726 726 + let rest = node.Entries |> List.skip (foundIdx + 1) 727 727 + 728 728 + let newRest = 729 729 + match rest with 730 730 + | [] -> [] 731 731 + | first :: rs -> 732 732 + let firstFullKey = 733 733 + let oldP = 734 734 + if first.PrefixLen > key.Length then 735 735 + key 736 736 + else 737 737 + key.Substring(0, first.PrefixLen) 738 738 + 739 739 + oldP + first.KeySuffix 740 740 + 741 741 + let newP = sharedPrefixLen mergePrevKey firstFullKey 742 742 + let newSuffix = firstFullKey.Substring(newP) 743 743 + let newFirst = { first with PrefixLen = newP; KeySuffix = newSuffix } 744 744 + newFirst :: rs 745 745 + 746 746 + before @ [ newPrevE ] @ newRest 747 747 + 748 748 + let newLeft = if foundIdx = 0 then Some mergedChildCid else node.Left 749 749 + 750 750 + let newNode = { Left = newLeft; Entries = newEntries } 751 751 + 752 752 + if newNode.Entries.IsEmpty && newNode.Left.IsNone then 753 753 + return None 754 754 + else 755 755 + return Some newNode 756 756 + 757 757 + else 758 758 + let childCid = 759 759 + if nextTreeIdx = -1 then 760 760 + node.Left 761 761 + else 762 762 + node.Entries.[nextTreeIdx].Tree 763 763 + 764 764 + match childCid with 765 765 + | None -> return Some node 766 766 + | Some cid -> 767 767 + let! childNodeOpt = loader cid 768 768 + 769 769 + match childNodeOpt with 770 770 + | None -> return Some node 771 771 + | Some childNode -> 772 772 + let! newChildOpt = delete loader persister childNode key currentKey 773 773 + 774 774 + match newChildOpt with 775 775 + | None -> 776 776 + if nextTreeIdx = -1 then 777 777 + return Some { node with Left = None } 778 778 + else 779 779 + let prevE = node.Entries.[nextTreeIdx] 780 780 + let newPrevE = { prevE with Tree = None } 781 781 + 782 782 + let newEntries = 783 783 + node.Entries 784 784 + |> List.mapi (fun idx x -> if idx = nextTreeIdx then newPrevE else x) 785 785 + 786 786 + return Some { node with Entries = newEntries } 787 787 + | Some newChild -> 788 788 + let! newChildCid = persister newChild 789 789 + 790 790 + if nextTreeIdx = -1 then 791 791 + return Some { node with Left = Some newChildCid } 792 792 + else 793 793 + let prevE = node.Entries.[nextTreeIdx] 794 794 + let newPrevE = { prevE with Tree = Some newChildCid } 795 795 + 796 796 + let newEntries = 797 797 + node.Entries 798 798 + |> List.mapi (fun idx x -> if idx = nextTreeIdx then newPrevE else x) 799 799 + 800 800 + return Some { node with Entries = newEntries } 801 801 + } 802 802 + 803 803 + let fromEntries (loader : NodeLoader) (persister : NodePersister) (entries : (string * Cid) list) : Async<MstNode> = async { 804 804 + let mutable root = { Left = None; Entries = [] } 805 805 + let sortedEntries = entries |> List.sortBy fst 806 806 + 807 807 + for k, v in sortedEntries do 808 808 + let! newRoot = put loader persister root k v "" 809 809 + root <- newRoot 810 810 + 811 811 + return root 812 812 + }

+1

PDSharp.Core/PDSharp.Core.fsproj

reviewed

··· 9 9 <Compile Include="Cid.fs" /> 10 10 <Compile Include="DagCbor.fs" /> 11 11 <Compile Include="Crypto.fs" /> 12 12 + <Compile Include="Mst.fs" /> 12 13 <Compile Include="DidResolver.fs" /> 13 14 <Compile Include="Library.fs" /> 14 15 </ItemGroup>

+264

PDSharp.Tests/Mst.Tests.fs

reviewed

··· 1 1 + module MstTests 2 2 + 3 3 + open Xunit 4 4 + open PDSharp.Core 5 5 + open PDSharp.Core.Mst 6 6 + 7 7 + [<Fact>] 8 8 + let ``Serialization Roundtrip`` () = 9 9 + let cid1 = Cid(Crypto.sha256Str "val1") 10 10 + 11 11 + let e1 = { 12 12 + PrefixLen = 0 13 13 + KeySuffix = "apple" 14 14 + Value = cid1 15 15 + Tree = None 16 16 + } 17 17 + 18 18 + let e2 = { 19 19 + PrefixLen = 2 20 20 + KeySuffix = "ricot" 21 21 + Value = cid1 22 22 + Tree = None 23 23 + } 24 24 + 25 25 + let node = { Left = None; Entries = [ e1; e2 ] } 26 26 + 27 27 + let bytes = Mst.serialize node 28 28 + let node2 = Mst.deserialize bytes 29 29 + 30 30 + Assert.Equal(node.Entries.Length, node2.Entries.Length) 31 31 + Assert.Equal("apple", node2.Entries.[0].KeySuffix) 32 32 + Assert.Equal("ricot", node2.Entries.[1].KeySuffix) 33 33 + Assert.Equal(2, node2.Entries.[1].PrefixLen) 34 34 + 35 35 + [<Fact>] 36 36 + let ``Get Operation Linear Scan`` () = 37 37 + let cid1 = Cid(Crypto.sha256Str "val1") 38 38 + let cid2 = Cid(Crypto.sha256Str "val2") 39 39 + 40 40 + let e1 = { 41 41 + PrefixLen = 0 42 42 + KeySuffix = "apple" 43 43 + Value = cid1 44 44 + Tree = None 45 45 + } 46 46 + 47 47 + let e2 = { 48 48 + PrefixLen = 0 49 49 + KeySuffix = "banana" 50 50 + Value = cid2 51 51 + Tree = None 52 52 + } 53 53 + 54 54 + let node = { Left = None; Entries = [ e1; e2 ] } 55 55 + 56 56 + let loader (c : Cid) = async { return None } 57 57 + 58 58 + let res1 = Mst.get loader node "apple" "" |> Async.RunSynchronously 59 59 + Assert.Equal(Some cid1, res1) 60 60 + 61 61 + let res2 = Mst.get loader node "banana" "" |> Async.RunSynchronously 62 62 + Assert.Equal(Some cid2, res2) 63 63 + 64 64 + let res3 = Mst.get loader node "cherry" "" |> Async.RunSynchronously 65 65 + Assert.True(Option.isNone res3) 66 66 + 67 67 + [<Fact>] 68 68 + let ``Get Operation With Prefix Compression`` () = 69 69 + let cid1 = Cid(Crypto.sha256Str "val1") 70 70 + let cid2 = Cid(Crypto.sha256Str "val2") 71 71 + 72 72 + let e1 = { 73 73 + PrefixLen = 0 74 74 + KeySuffix = "apple" 75 75 + Value = cid1 76 76 + Tree = None 77 77 + } 78 78 + 79 79 + let e2 = { 80 80 + PrefixLen = 2 81 81 + KeySuffix = "ricot" 82 82 + Value = cid2 83 83 + Tree = None 84 84 + } 85 85 + 86 86 + let node = { Left = None; Entries = [ e1; e2 ] } 87 87 + let loader (c : Cid) = async { return None } 88 88 + 89 89 + let res1 = Mst.get loader node "apricot" "" |> Async.RunSynchronously 90 90 + Assert.Equal(Some cid2, res1) 91 91 + 92 92 + [<Fact>] 93 93 + let ``Put Operation Simple Insert`` () = 94 94 + let store = System.Collections.Concurrent.ConcurrentDictionary<string, MstNode>() 95 95 + 96 96 + let loader (c : Cid) = async { 97 97 + let key = System.Convert.ToBase64String(c.Bytes) 98 98 + let success, node = store.TryGetValue(key) 99 99 + return if success then Some node else None 100 100 + } 101 101 + 102 102 + let persister (n : MstNode) = async { 103 103 + let bytes = Mst.serialize n 104 104 + let cid = Cid(Crypto.sha256 bytes) 105 105 + let key = System.Convert.ToBase64String(cid.Bytes) 106 106 + store.[key] <- n 107 107 + return cid 108 108 + } 109 109 + 110 110 + let node = { Left = None; Entries = [] } 111 111 + let cid1 = Cid(Crypto.sha256Str "v1") 112 112 + let node2 = Mst.put loader persister node "apple" cid1 "" |> Async.RunSynchronously 113 113 + 114 114 + Assert.Equal(1, node2.Entries.Length) 115 115 + Assert.Equal("apple", node2.Entries.[0].KeySuffix) 116 116 + Assert.Equal(0, node2.Entries.[0].PrefixLen) 117 117 + Assert.Equal(cid1, node2.Entries.[0].Value) 118 118 + 119 119 + let res = Mst.get loader node2 "apple" "" |> Async.RunSynchronously 120 120 + Assert.Equal(Some cid1, res) 121 121 + 122 122 + [<Fact>] 123 123 + let ``Put Operation Multiple Sorted`` () = 124 124 + let store = System.Collections.Concurrent.ConcurrentDictionary<string, MstNode>() 125 125 + 126 126 + let loader (c : Cid) = async { 127 127 + let key = System.Convert.ToBase64String(c.Bytes) 128 128 + let success, node = store.TryGetValue(key) 129 129 + return if success then Some node else None 130 130 + } 131 131 + 132 132 + let persister (n : MstNode) = async { 133 133 + let bytes = Mst.serialize n 134 134 + let cid = Cid(Crypto.sha256 bytes) 135 135 + let key = System.Convert.ToBase64String(cid.Bytes) 136 136 + store.[key] <- n 137 137 + return cid 138 138 + } 139 139 + 140 140 + let mutable node = { Left = None; Entries = [] } 141 141 + 142 142 + let k1, v1 = "apple", Cid(Crypto.sha256Str "1") 143 143 + let k2, v2 = "banana", Cid(Crypto.sha256Str "2") 144 144 + let k3, v3 = "cherry", Cid(Crypto.sha256Str "3") 145 145 + 146 146 + node <- Mst.put loader persister node k1 v1 "" |> Async.RunSynchronously 147 147 + node <- Mst.put loader persister node k2 v2 "" |> Async.RunSynchronously 148 148 + node <- Mst.put loader persister node k3 v3 "" |> Async.RunSynchronously 149 149 + 150 150 + let g1 = Mst.get loader node "apple" "" |> Async.RunSynchronously 151 151 + let g2 = Mst.get loader node "banana" "" |> Async.RunSynchronously 152 152 + let g3 = Mst.get loader node "cherry" "" |> Async.RunSynchronously 153 153 + 154 154 + Assert.Equal(Some v1, g1) 155 155 + Assert.Equal(Some v2, g2) 156 156 + Assert.Equal(Some v3, g3) 157 157 + 158 158 + [<Fact>] 159 159 + let ``Put Operation Multiple Reverse`` () = 160 160 + let store = System.Collections.Concurrent.ConcurrentDictionary<string, MstNode>() 161 161 + 162 162 + let loader (c : Cid) = async { 163 163 + let key = System.Convert.ToBase64String(c.Bytes) 164 164 + let success, node = store.TryGetValue(key) 165 165 + return if success then Some node else None 166 166 + } 167 167 + 168 168 + let persister (n : MstNode) = async { 169 169 + let bytes = Mst.serialize n 170 170 + let cid = Cid(Crypto.sha256 bytes) 171 171 + let key = System.Convert.ToBase64String(cid.Bytes) 172 172 + store.[key] <- n 173 173 + return cid 174 174 + } 175 175 + 176 176 + let mutable node = { Left = None; Entries = [] } 177 177 + 178 178 + let data = [ "zebra"; "yak"; "xylophone" ] 179 179 + 180 180 + for k in data do 181 181 + let v = Cid(Crypto.sha256Str k) 182 182 + node <- Mst.put loader persister node k v "" |> Async.RunSynchronously 183 183 + 184 184 + for k in data do 185 185 + let expected = Cid(Crypto.sha256Str k) 186 186 + let actual = Mst.get loader node k "" |> Async.RunSynchronously 187 187 + Assert.Equal(Some expected, actual) 188 188 + 189 189 + [<Fact>] 190 190 + let ``Delete Operation Simple`` () = 191 191 + let store = System.Collections.Concurrent.ConcurrentDictionary<string, MstNode>() 192 192 + 193 193 + let loader (c : Cid) = async { 194 194 + let key = System.Convert.ToBase64String(c.Bytes) 195 195 + let success, node = store.TryGetValue(key) 196 196 + return if success then Some node else None 197 197 + } 198 198 + 199 199 + let persister (n : MstNode) = async { 200 200 + let bytes = Mst.serialize n 201 201 + let cid = Cid(Crypto.sha256 bytes) 202 202 + let key = System.Convert.ToBase64String(cid.Bytes) 203 203 + store.[key] <- n 204 204 + return cid 205 205 + } 206 206 + 207 207 + let mutable node = { Left = None; Entries = [] } 208 208 + let cid1 = Cid(Crypto.sha256Str "val1") 209 209 + 210 210 + node <- Mst.put loader persister node "apple" cid1 "" |> Async.RunSynchronously 211 211 + 212 212 + let res1 = Mst.get loader node "apple" "" |> Async.RunSynchronously 213 213 + Assert.Equal(Some cid1, res1) 214 214 + 215 215 + // Delete 216 216 + let nodeOpt = Mst.delete loader persister node "apple" "" |> Async.RunSynchronously 217 217 + 218 218 + match nodeOpt with 219 219 + | None -> () 220 220 + | Some n -> 221 221 + let res2 = Mst.get loader n "apple" "" |> Async.RunSynchronously 222 222 + Assert.True(Option.isNone res2) 223 223 + 224 224 + [<Fact>] 225 225 + let ``Determinism From Entries`` () = 226 226 + let store = System.Collections.Concurrent.ConcurrentDictionary<string, MstNode>() 227 227 + 228 228 + let loader (c : Cid) = async { 229 229 + let key = System.Convert.ToBase64String(c.Bytes) 230 230 + let success, node = store.TryGetValue(key) 231 231 + return if success then Some node else None 232 232 + } 233 233 + 234 234 + let persister (n : MstNode) = async { 235 235 + let bytes = Mst.serialize n 236 236 + let cid = Cid(Crypto.sha256 bytes) 237 237 + let key = System.Convert.ToBase64String(cid.Bytes) 238 238 + store.[key] <- n 239 239 + return cid 240 240 + } 241 241 + 242 242 + let data = [ 243 243 + "apple", Cid(Crypto.sha256Str "1") 244 244 + "banana", Cid(Crypto.sha256Str "2") 245 245 + "cherry", Cid(Crypto.sha256Str "3") 246 246 + "date", Cid(Crypto.sha256Str "4") 247 247 + "elderberry", Cid(Crypto.sha256Str "5") 248 248 + ] 249 249 + 250 250 + 251 251 + let node1 = Mst.fromEntries loader persister data |> Async.RunSynchronously 252 252 + let cid1 = persister node1 |> Async.RunSynchronously 253 253 + 254 254 + let node2 = 255 255 + Mst.fromEntries loader persister (List.rev data) |> Async.RunSynchronously 256 256 + 257 257 + let cid2 = persister node2 |> Async.RunSynchronously 258 258 + let data3 = [ data.[2]; data.[0]; data.[4]; data.[1]; data.[3] ] 259 259 + let node3 = Mst.fromEntries loader persister data3 |> Async.RunSynchronously 260 260 + let cid3 = persister node3 |> Async.RunSynchronously 261 261 + 262 262 + Assert.Equal(cid1, cid2) 263 263 + Assert.Equal(cid1, cid3) 264 264 + ()

+4 -3

PDSharp.Tests/PDSharp.Tests.fsproj

reviewed

··· 8 8 9 9 <ItemGroup> 10 10 <Compile Include="Tests.fs" /> 11 11 + <Compile Include="Mst.Tests.fs" /> 11 12 <Compile Include="Program.fs" /> 12 13 </ItemGroup> 13 14 ··· 18 19 <PackageReference Include="xunit.runner.visualstudio" Version="2.8.2" /> 19 20 </ItemGroup> 20 21 21 21 - <ItemGroup> 22 22 - <ProjectReference Include="..\PDSharp\PDSharp.fsproj" /> 23 23 - <ProjectReference Include="..\PDSharp.Core\PDSharp.Core.fsproj" /> 22 22 + <ItemGroup> 23 23 + <ProjectReference Include="..\PDSharp\PDSharp.fsproj" /> 24 24 + <ProjectReference Include="..\PDSharp.Core\PDSharp.Core.fsproj" /> 24 25 </ItemGroup> 25 26 26 27 </Project>

+4 -4

roadmap.txt

reviewed

··· 23 23 -------------------------------------------------------------------------------- 24 24 Milestone D: MST Implementation 25 25 -------------------------------------------------------------------------------- 26 26 - - Merkle Search Tree per repository spec 27 27 - - Key depth = leading zero bits in SHA-256(key) counted in 2-bit chunks 28 28 - - Node encoding: (l, e[p,k,v,t]) with key prefix compression 26 26 + - [x] Merkle Search Tree per repository spec 27 27 + - [x] Key depth = leading zero bits in SHA-256(key) counted in 2-bit chunks 28 28 + - [x] Node encoding: (l, e[p,k,v,t]) with key prefix compression 29 29 DoD: Insert/update/delete yields reproducible root CID 30 30 -------------------------------------------------------------------------------- 31 31 Milestone E: Commit + BlockStore + putRecord ··· 117 117 [ ] describeServer endpoint working 118 118 [ ] Crypto primitives (sha256, ECDSA p256/k256, low-S) 119 119 [ ] DAG-CBOR + CID generation correct 120 120 - [ ] MST producing deterministic root CIDs 120 120 + [x] MST producing deterministic root CIDs 121 121 [ ] putRecord + blockstore operational 122 122 [ ] CAR export + sync endpoints 123 123 [ ] subscribeRepos firehose