objects.tri (2865B)
1 !import base as B 2 !import native_math as N 3 !import io_v2 as IO 4 !export putTree 5 !export getTree 6 !export validDigest 7 8 -- Source-owned indexed-object policy. The store root must already exist; its 9 -- creation/parent durability belongs to the caller. Root paths use OS resolution; 10 -- callers must account for symlinks, renames and external mutable writers. 11 hexDigit value = case value of 12 48 = t t 13 49 = t t 14 50 = t t 15 51 = t t 16 52 = t t 17 53 = t t 18 54 = t t 19 55 = t t 20 56 = t t 21 57 = t t 22 97 = t t 23 98 = t t 24 99 = t t 25 100 = t t 26 101 = t t 27 102 = t t 28 _ = t 29 30 validDigest value = let rec 31 walk 0 [] = t t 32 walk 0 _ = t 33 walk count [c | rest] = case hexDigit c of 34 (t t) = walk (N.predecessor count) rest 35 _ = t 36 walk _ _ = t 37 in walk 64 value 38 39 shard [a b c | _] = [a b c] 40 shard _ = [] 41 objects root = B.append root "/objects" 42 shardPath root digest = B.append (objects root) (B.pair 47 (shard digest)) 43 objectPath root digest = B.append (shardPath root digest) (B.pair 47 digest) 44 45 -- Verify every winner, including a new publication, byte-for-byte and through 46 -- EOF. Sync the verified open inode and its containing directory before returning 47 -- a digest that callers may publish in a manifest/cache/alias. Failed verification 48 -- leaves the winner intact. Durability follows OS/filesystem synchronization 49 -- guarantees; external writers can mutate paths concurrently. 50 verify owner root limit digest tree = do IO.onOk 51 reader <- IO.openReader owner (objectPath root digest) 52 IO.verifyIndexedTree reader limit tree 53 end <- IO.readSome reader 1 54 case end of 55 ("eof", t) = do IO.onOk 56 IO.syncFile reader 57 IO.syncDirectory (shardPath root digest) 58 IO.pure (B.ok digest t) 59 _ = IO.pure (B.err ["invalid-data" "objects/verify" "trailing bytes" "unknown"] t) 60 61 putTree root limit tree = IO.scope (owner : do IO.onOk 62 IO.syncDirectory root 63 info <- IO.hashIndexedTree limit tree 64 case info of 65 [size digest] = do IO.onOk 66 IO.ensureDirectory (objects root) 67 IO.syncDirectory root 68 IO.ensureDirectory (shardPath root digest) 69 IO.syncDirectory (objects root) 70 stage <- IO.openStage owner (shardPath root digest) 71 IO.writeIndexedTree stage limit digest tree 72 IO.sealStage stage 73 status <- IO.publishNew stage (objectPath root digest) 74 case status of 75 "published" = verify owner root limit digest tree 76 "exists" = verify owner root limit digest tree 77 _ = IO.fail "Invalid publication reply" 78 _ = IO.fail "Invalid indexed hash reply") 79 80 getTree root limit digest = case validDigest digest of 81 (t t) = IO.scope (owner : do IO.onOk 82 reader <- IO.openReader owner (objectPath root digest) 83 size <- IO.fileSize reader 84 IO.readIndexedTree reader root limit size digest) 85 _ = IO.pure (B.err ["invalid-argument" "objects/get" "invalid CAS digest" "none"] t)