Generate SSD truth store local paths from typed Jerboa

ober

f3322b6532451a433af16e3383a5dc78f5065162

diff --git a/.build.yml b/.build.yml
index a871c7d..7e0e092 100644
--- a/.build.yml
+++ b/.build.yml
@@ -5,7 +5,7 @@ packages:
   - make=4.4.1-r4
 sources:
   # Build dependency: full immutable commit, mirrored in dependencies.lock.json.
-  - "https://git.sr.ht/~lisp/jerboa#75fe436882fc90a2d8375b8f2000e6a829f77b7c"
+  - "https://git.sr.ht/~lisp/jerboa#dfb64812ae3c12e43f4b54253eaacd7c028bd5ff"
   # The second source is the build subject selected by the SourceHut submitter.
   - https://git.sr.ht/~lisp/jerboa-android
 tasks:
@@ -14,6 +14,6 @@ tasks:
       test "$(apk info -v chez-scheme)" = chez-scheme-10.3.0-r2
       test "$(apk info -v git)" = git-2.54.0-r0
       test "$(apk info -v make)" = make-4.4.1-r4
-      test "$(git -C ../jerboa rev-parse HEAD)" = 75fe436882fc90a2d8375b8f2000e6a829f77b7c
-      test "$(git -C ../jerboa rev-parse 'HEAD^{tree}')" = 883737c903b9a6d8b9200911a1ad77f8844e0597
+      test "$(git -C ../jerboa rev-parse HEAD)" = dfb64812ae3c12e43f4b54253eaacd7c028bd5ff
+      test "$(git -C ../jerboa rev-parse 'HEAD^{tree}')" = d040cb9597be969071941ad645e932fcfc5618eb
       JERBOA="chez --libdirs .:../jerboa/lib --script" make test
diff --git a/dependencies.lock.json b/dependencies.lock.json
index 4723e8b..edb5364 100644
--- a/dependencies.lock.json
+++ b/dependencies.lock.json
@@ -11,8 +11,8 @@
   "generator_runtime": {
     "name": "jerboa",
     "repository": "https://git.sr.ht/~lisp/jerboa",
-    "commit": "75fe436882fc90a2d8375b8f2000e6a829f77b7c",
-    "tree": "883737c903b9a6d8b9200911a1ad77f8844e0597"
+    "commit": "dfb64812ae3c12e43f4b54253eaacd7c028bd5ff",
+    "tree": "d040cb9597be969071941ad645e932fcfc5618eb"
   },
   "assurance_tools": {
     "osv_scanner": {
diff --git a/scripts/verify-supply-chain.sh b/scripts/verify-supply-chain.sh
index 2d946b0..6f8d369 100755
--- a/scripts/verify-supply-chain.sh
+++ b/scripts/verify-supply-chain.sh
@@ -3,8 +3,8 @@ set -eu
 
 repo=$(CDPATH= cd -- "$(dirname -- "$0")/.." && pwd -P)
 lock="$repo/dependencies.lock.json"
-jerboa_commit=75fe436882fc90a2d8375b8f2000e6a829f77b7c # gitsafe:ignore
-jerboa_tree=883737c903b9a6d8b9200911a1ad77f8844e0597 # gitsafe:ignore
+jerboa_commit=dfb64812ae3c12e43f4b54253eaacd7c028bd5ff # gitsafe:ignore
+jerboa_tree=d040cb9597be969071941ad645e932fcfc5618eb # gitsafe:ignore
 gradle_sha=20f1b1176237254a6fc204d8434196fa11a4cfb387567519c61556e8710aed78
 jdk_macos_sha=8fa1eff40bb637a33613b2ccb8b12c70dc3661cc22cf8e784943715769a05336
 jdk_linux_sha=d8afc263758141a66e0e3aafc321e783f7016696f4eaea067d340a269037d331
diff --git a/templates/ssd-review.ss b/templates/ssd-review.ss
index f5341e4..c4d98d1 100644
--- a/templates/ssd-review.ss
+++ b/templates/ssd-review.ss
@@ -15527,6 +15527,132 @@
           (int32 4096)
           (modifiers internal const))))
 
+    (typed-kotlin-file "com/sfb/ssdreview/TruthStoreLocal.kt"
+      (kotlin-imports (java io File)
+                      (java io InputStream)
+                      (java nio file LinkOption)
+                      (java nio file Path)
+                      (java security MessageDigest)
+                      (org json JSONObject))
+      (typed-library (com sfb ssdreview)
+        (export truthStoreSha256Hex truthStoreContainedLeaf
+                truthStoreReadLocalText truthStoreTruthPath
+                truthStoreLoadTruth)
+        (type Exception)
+        (type File)
+        (type InputStream)
+        (type LinkOption)
+        (type MessageDigest)
+        (type Path)
+        (type TruthStore)
+        (type JSONObject)
+        (extern (truthStoreGroundTruthDir
+                  (store : TruthStore)) : File
+          (kotlin-member-get groundTruthDir))
+        (extern (truthStoreFileInputStream
+                  (file : File)) : InputStream
+          (kotlin-member-call inputStream))
+        (extern (truthStoreInputStreamClose
+                  (input : InputStream)) : Unit
+          (kotlin-member-call close))
+        (extern (truthStoreFileToPath
+                  (file : File)) : Path
+          (kotlin-member-call toPath))
+        (extern (truthStorePathToRealPath
+                  (path : Path)
+                  (option : LinkOption)) : Path
+          (kotlin-member-call toRealPath))
+        (extern (truthStorePathResolve
+                  (path : Path)
+                  (leaf : String)) : Path
+          (kotlin-member-call resolve))
+        (extern (truthStorePathNormalize
+                  (path : Path)) : Path
+          (kotlin-member-call normalize))
+        (extern (truthStorePathToFile
+                  (path : Path)) : File
+          (kotlin-member-call toFile))
+        (extern (truthStoreNoFollowLinks) : LinkOption
+          (kotlin-value LinkOption NOFOLLOW_LINKS))
+        (extern (truthStoreIllegalArgumentException
+                  (message : String)) : Exception
+          (kotlin-call IllegalArgumentException))
+        (extern (truthStoreMessageDigestGetInstance
+                  (algorithm : String)) : MessageDigest
+          (kotlin-call MessageDigest getInstance))
+        (extern (truthStoreMessageDigestDigest
+                  (digest : MessageDigest)
+                  (bytes : Bytes)) : Bytes
+          (kotlin-member-call digest))
+        (extern (truthStoreMaxZipEntryBytes) : Int
+          (kotlin-value MAX_ZIP_ENTRY_BYTES))
+        (def (truthStoreSha256Hex (bytes : Bytes)) : String
+          (bytesToLowerHex
+            (truthStoreMessageDigestDigest
+              (truthStoreMessageDigestGetInstance "SHA-256")
+              bytes)))
+        (def (truthStoreContainedLeaf
+               (base : File)
+               (leaf : String)) : File
+          (if (safeLeaf leaf)
+            (let ((basePath
+                    (truthStorePathToRealPath
+                      (truthStoreFileToPath base)
+                      (truthStoreNoFollowLinks))))
+              (begin
+                (if (pathNotSymbolicLink basePath)
+                  (begin)
+                  (throw
+                    (truthStoreIllegalArgumentException
+                      "Symlinked storage root rejected")
+                    Unit))
+                (let ((target
+                        (truthStorePathNormalize
+                          (truthStorePathResolve basePath leaf))))
+                  (begin
+                    (if (pathParentMatches target basePath)
+                      (begin)
+                      (throw
+                        (truthStoreIllegalArgumentException
+                          "Local path escaped storage root")
+                        Unit))
+                    (truthStorePathToFile target)))))
+            (throw
+              (truthStoreIllegalArgumentException "Unsafe local leaf")
+              File)))
+        (def (truthStoreReadLocalText (file : File)) : String
+          (if (safeLocalRegularFile file)
+            (let ((input (truthStoreFileInputStream file)))
+              (try-finally
+                (utf8->string
+                  (readBoundedBytes input (truthStoreMaxZipEntryBytes)))
+                (truthStoreInputStreamClose input)))
+            (throw
+              (truthStoreIllegalArgumentException "Unsafe local file")
+              String)))
+        (def (truthStoreTruthPath
+               (store : TruthStore)
+               (sourceKey : String)) : File
+          (let ((validated (validatedSourceKey sourceKey)))
+            (if (validatedSourceKeyPresent validated)
+              (let ((key (validatedSourceKeyOrEmpty validated)))
+                (truthStoreContainedLeaf
+                  (truthStoreGroundTruthDir store)
+                  (truthFileName
+                    (truthStoreSha256Hex (textUtf8Bytes key)))))
+              (throw
+                (truthStoreIllegalArgumentException "Invalid source key")
+                File))))
+        (def (truthStoreLoadTruth
+               (store : TruthStore)
+               (sourceKey : String)) : (Nullable JSONObject)
+          (let ((file (truthStoreTruthPath store sourceKey)))
+            (if (localFileMissing file)
+              (nullable-none JSONObject)
+              (nullable-some
+                (jsonObjectFromText
+                  (truthStoreReadLocalText file))))))))
+
     (kotlin-file-lines "com/sfb/ssdreview/TruthStore.kt"
       (
        "package com.sfb.ssdreview"
@@ -15573,7 +15699,7 @@
        ""
        "class TruthStore(private val context: Context) {"
        "    private val root = File(context.filesDir, \"ssd_review\")"
-       "    private val groundTruthDir = File(root, \"ground_truth\")"
+       "    internal val groundTruthDir = File(root, \"ground_truth\")"
        "    private val learnedDir = File(root, \"learned\")"
        "    private val eventsDir = File(root, \"events\")"
        "    private val reviewsDir = File(root, \"reviews\")"
@@ -15586,18 +15712,11 @@
        "        ensureTruthStoreDirectories(root, groundTruthDir, learnedDir, eventsDir, reviewsDir)"
        "    }"
        ""
-       "    fun truthPath(sourceKey: String): File {"
-       "        val validated = validatedSourceKey(sourceKey)"
-       "        if (!validatedSourceKeyPresent(validated)) throw IllegalArgumentException(\"Invalid source key\")"
-       "        val key = validatedSourceKeyOrEmpty(validated)"
-       "        return containedLeaf(groundTruthDir, truthFileName(sha256Hex(key.toByteArray())))"
-       "    }"
+       "    fun truthPath(sourceKey: String): File ="
+       "        truthStoreTruthPath(this, sourceKey)"
        ""
-       "    fun loadTruth(sourceKey: String): JSONObject? {"
-       "        val file = truthPath(sourceKey)"
-       "        if (localFileMissing(file)) return null"
-       "        return jsonObjectFromText(readLocalText(file))"
-       "    }"
+       "    fun loadTruth(sourceKey: String): JSONObject? ="
+       "        truthStoreLoadTruth(this, sourceKey)"
        ""
        "    fun loadTruth(session: SsdSession): JSONObject? {"
        "        val best = bestTruthIndexForSession("
@@ -15675,16 +15794,10 @@
 	       "    }"
        ""
        "    private fun sha256Hex(bytes: ByteArray): String ="
-       "        bytesToLowerHex(MessageDigest.getInstance(\"SHA-256\").digest(bytes))"
+       "        truthStoreSha256Hex(bytes)"
        ""
-       "    private fun containedLeaf(base: File, leaf: String): File {"
-       "        require(safeLeaf(leaf)) { \"Unsafe local leaf\" }"
-       "        val basePath = base.toPath().toRealPath(LinkOption.NOFOLLOW_LINKS)"
-       "        require(pathNotSymbolicLink(basePath)) { \"Symlinked storage root rejected\" }"
-       "        val target = basePath.resolve(leaf).normalize()"
-       "        require(pathParentMatches(target, basePath)) { \"Local path escaped storage root\" }"
-       "        return target.toFile()"
-       "    }"
+       "    private fun containedLeaf(base: File, leaf: String): File ="
+       "        truthStoreContainedLeaf(base, leaf)"
        ""
        "    private fun storageStats(): StorageStats {"
        "        val stats = StorageStats(0, 0L)"
@@ -16336,10 +16449,8 @@
        "        return containedLeaf(directory, zipEntryLeafName(name, '/'))"
        "    }"
        ""
-       "    private fun readLocalText(file: File): String {"
-       "        require(safeLocalRegularFile(file)) { \"Unsafe local file\" }"
-       "        return file.inputStream().use { readBoundedBytes(it, MAX_ZIP_ENTRY_BYTES).decodeToString() }"
-       "    }"
+       "    private fun readLocalText(file: File): String ="
+       "        truthStoreReadLocalText(file)"
        ""
        "}"
        ""
diff --git a/tests/ssd-security-test.sh b/tests/ssd-security-test.sh
index 7a8be2b..b55b649 100755
--- a/tests/ssd-security-test.sh
+++ b/tests/ssd-security-test.sh
@@ -53,7 +53,8 @@ require_text 'setRequestProperty("Authorization", bearerAuthorizationHeader(conf
 require_text 'context.getSharedPreferences("ssd_review_remote", Context.MODE_PRIVATE)'
 require_text 'Remote SSD service is not locally configured'
 require_text 'validatedSourceKey'
-require_text 'sha256Hex(key.toByteArray())'
+require_generated_text 'truthStoreSha256Hex'
+require_generated_text 'textUtf8Bytes(key)'
 require_text 'StandardCopyOption.ATOMIC_MOVE'
 require_text 'LinkOption.NOFOLLOW_LINKS'
 require_text 'LimitedInputStream(input, MAX_REMOTE_ZIP_BYTES)'