tricu

A lazy functional language based on Tree Calculus
Log | Files | Refs | README | LICENSE

objects.tri (2872B)

      1 !import base as B
      2 !import native_math as N
      3 !import io 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)