Generate SSD ZIP exports from typed Jerboa

ober

a530bf398e309b91fc2454dfed95477511d62cab

diff --git a/templates/ssd-review.ss b/templates/ssd-review.ss
index 6618052..41824c7 100644
--- a/templates/ssd-review.ss
+++ b/templates/ssd-review.ss
@@ -15559,6 +15559,7 @@
                       (android content res AssetManager)
                       (android util Base64)
                       (java io File)
+                      (java io BufferedOutputStream)
                       (java io InputStream)
                       (java io OutputStream)
                       (java net URL)
@@ -15568,7 +15569,9 @@
                       (java time Instant)
                       (java time OffsetDateTime)
                       (java time format DateTimeFormatter)
+                      (java util zip ZipEntry)
                       (java util zip ZipInputStream)
+                      (java util zip ZipOutputStream)
                       (javax net ssl HttpsURLConnection)
                       (org json JSONArray)
                       (org json JSONObject))
@@ -15585,6 +15588,7 @@
                 truthStoreInvalidateTruthIndexLocal
                 truthStoreTruthIndexEntriesLocal
                 truthStoreTruthIndexEntryLocal
+                truthStoreExportZipLocal
                 truthStoreReadResponseTextLocal
                 truthStoreWriteRemoteTruthLocal
                 truthStoreApplyLearnedGuessesLocal
@@ -15604,6 +15608,7 @@
                 truthStorePullRemoteDumpLocal)
         (type AssetManager)
         (type Any)
+        (type BufferedOutputStream)
         (type Context)
         (type DateTimeFormatter)
         (type Exception)
@@ -15628,7 +15633,9 @@
         (type URL)
         (type JSONArray)
         (type JSONObject)
+        (type ZipEntry)
         (type ZipInputStream)
+        (type ZipOutputStream)
         (extern (truthStoreRoot
                   (store : TruthStore)) : File
           (kotlin-member-get root))
@@ -15794,6 +15801,39 @@
                   (input : InputStream)
                   (limit : Int)) : InputStream
           (kotlin-call LimitedInputStream))
+        (extern (truthStoreLimitedOutputStream
+                  (output : OutputStream)
+                  (limit : Int)) : OutputStream
+          (kotlin-call LimitedOutputStream))
+        (extern (truthStoreBufferedOutputStream
+                  (output : OutputStream)) : BufferedOutputStream
+          (kotlin-call BufferedOutputStream))
+        (extern (truthStoreZipOutputStream
+                  (output : BufferedOutputStream)) : ZipOutputStream
+          (kotlin-call ZipOutputStream))
+        (extern (truthStoreZipEntry
+                  (name : String)) : ZipEntry
+          (kotlin-call ZipEntry))
+        (extern (truthStoreZipPutNextEntry
+                  (zip : ZipOutputStream)
+                  (entry : ZipEntry)) : Unit
+          (kotlin-member-call putNextEntry))
+        (extern (truthStoreZipCloseEntry
+                  (zip : ZipOutputStream)) : Unit
+          (kotlin-member-call closeEntry))
+        (extern (truthStoreZipClose
+                  (zip : ZipOutputStream)) : Unit
+          (kotlin-member-call close))
+        (extern (truthStoreInputStreamRead
+                  (input : InputStream)
+                  (buffer : Bytes)) : Int32
+          (kotlin-member-call read))
+        (extern (truthStoreZipWrite
+                  (zip : ZipOutputStream)
+                  (buffer : Bytes)
+                  (offset : Int32)
+                  (length : Int32)) : Unit
+          (kotlin-member-call write))
         (extern (truthStoreContextModePrivate) : Int32
           (kotlin-value Context MODE_PRIVATE))
         (extern (truthStoreSharedPreferences
@@ -15838,12 +15878,19 @@
                   (path : Path)
                   (leaf : String)) : Path
           (kotlin-member-call resolve))
+        (extern (truthStorePathRelativize
+                  (base : Path)
+                  (target : Path)) : Path
+          (kotlin-member-call relativize))
         (extern (truthStorePathNormalize
                   (path : Path)) : Path
           (kotlin-member-call normalize))
         (extern (truthStorePathToFile
                   (path : Path)) : File
           (kotlin-member-call toFile))
+        (extern (truthStorePathToString
+                  (path : Path)) : String
+          (kotlin-member-call toString))
         (extern (truthStoreCreateTempFile
                   (prefix : String)
                   (suffix : String)
@@ -15894,6 +15941,8 @@
           (kotlin-value MAX_REMOTE_ZIP_BYTES))
         (extern (truthStoreMaxZipTotalBytes) : Int
           (kotlin-value MAX_ZIP_TOTAL_BYTES))
+        (extern (truthStoreMaxZipEntries) : Int32
+          (kotlin-value MAX_ZIP_ENTRIES))
         (extern (truthStoreRatioFloorBytes) : Int
           (kotlin-value RATIO_FLOOR_BYTES))
         (extern (truthStoreMaxCompressionRatio) : Int
@@ -16417,6 +16466,142 @@
                 (truthStoreTruthIndexCacheSet store entries)
                 (truthStoreTruthIndexCacheLoadedSet store #t)
                 entries))))
+        (def (truthStoreCopyInputToZipOutput
+               (input : InputStream)
+               (zip : ZipOutputStream)
+               (limit : Int)) : Unit
+          (if (boundedReadLimitValid limit)
+            (let ((buffer (make-bytevector (int32 32768) 0)))
+              (var ((total (int 0)))
+                (while #t
+                  (let ((read (truthStoreInputStreamRead input buffer)))
+                    (begin
+                      (if (streamReadEnded read) (break) (begin))
+                      (if (streamReadEmpty read) (continue) (begin))
+                      (set! total (+ total (int read)))
+                      (if (inputCountExceeded total limit)
+                        (throw
+                          (truthStoreIllegalStateException
+                            (inputLimitExceededMessage limit))
+                          Unit)
+                        (begin))
+                      (truthStoreZipWrite zip buffer (int32 0) read))))))
+            (throw
+              (truthStoreIllegalArgumentException "Invalid bounded read limit")
+              Unit)))
+        (def (truthStoreCopyFileToZipEntry
+               (zip : ZipOutputStream)
+               (file : File)) : Unit
+          (let ((input (truthStoreFileInputStream file)))
+            (try-finally
+              (truthStoreCopyInputToZipOutput
+                input
+                zip
+                (truthStoreMaxZipEntryBytes))
+              (truthStoreInputStreamClose input))))
+        (def (truthStoreRelativeExportPath
+               (store : TruthStore)
+               (file : File)) : String
+          (truthStorePathToString
+            (truthStorePathRelativize
+              (truthStoreFileToPath (truthStoreRoot store))
+              (truthStoreFileToPath file))))
+        (def (truthStoreAccountExportFile!
+               (budget : ImportBudget)
+               (file : File)) : Unit
+          (begin
+            (ImportBudget-entries-set!
+              budget
+              (+ (ImportBudget-entries budget) (int32 1)))
+            (ImportBudget-expandedBytes-set!
+              budget
+              (+ (ImportBudget-expandedBytes budget) (fileSizeBytes file)))
+            (if (zipExportQuotaExceeded
+                  (ImportBudget-entries budget)
+                  (fileSizeBytes file)
+                  (ImportBudget-expandedBytes budget)
+                  (truthStoreMaxZipEntries)
+                  (truthStoreMaxZipEntryBytes)
+                  (truthStoreMaxZipTotalBytes))
+              (throw
+                (truthStoreIllegalStateException
+                  "ZIP export quota exceeded")
+                Unit)
+              (begin))))
+        (def (truthStoreExportFileToZipLocal
+               (store : TruthStore)
+               (zip : ZipOutputStream)
+               (budget : ImportBudget)
+               (file : File)) : Unit
+          (begin
+            (if (fileIsSymbolicLink file)
+              (throw
+                (truthStoreIllegalStateException
+                  "Storage symlink rejected")
+                Unit)
+              (begin))
+            (truthStoreAccountExportFile! budget file)
+            (let ((relative
+                    (truthStoreRelativeExportPath store file)))
+              (begin
+                (truthStoreRequired
+                  (safeZipEntryName relative)
+                  "Unsafe local export path")
+                (truthStoreZipPutNextEntry
+                  zip
+                  (truthStoreZipEntry relative))
+                (try-finally
+                  (truthStoreCopyFileToZipEntry zip file)
+                  (truthStoreZipCloseEntry zip))))))
+        (def (truthStoreExportDirectoryToZipLocal
+               (store : TruthStore)
+               (zip : ZipOutputStream)
+               (budget : ImportBudget)
+               (dir : File)) : Unit
+          (forEachRegularFileUnder
+            dir
+            (lambda ((file : File))
+              (truthStoreExportFileToZipLocal
+                store
+                zip
+                budget
+                file))))
+        (def (truthStoreExportZipLocal
+               (store : TruthStore)
+               (output : OutputStream)) : Unit
+          (begin
+            (truthStoreStorageStatsLocal store)
+            (let ((zip
+                    (truthStoreZipOutputStream
+                      (truthStoreBufferedOutputStream
+                        (truthStoreLimitedOutputStream
+                          output
+                          (truthStoreMaxZipTotalBytes)))))
+                  (budget
+                    (make-ImportBudget (int32 0) (int 0))))
+              (try-finally
+                (begin
+                  (truthStoreExportDirectoryToZipLocal
+                    store
+                    zip
+                    budget
+                    (truthStoreGroundTruthDir store))
+                  (truthStoreExportDirectoryToZipLocal
+                    store
+                    zip
+                    budget
+                    (truthStoreLearnedDir store))
+                  (truthStoreExportDirectoryToZipLocal
+                    store
+                    zip
+                    budget
+                    (truthStoreEventsDir store))
+                  (truthStoreExportDirectoryToZipLocal
+                    store
+                    zip
+                    budget
+                    (truthStoreReviewsDir store)))
+                (truthStoreZipClose zip)))))
         (def (truthStoreSeedBundledTruthLocal
                (store : TruthStore)
                (context : Context)) : Int32
@@ -16676,7 +16861,7 @@
           (let ((output
                   (truthStoreFileOutputStream archive)))
             (try-finally
-              (truthStoreExportZipRaw store output)
+              (truthStoreExportZipLocal store output)
               (truthStoreOutputStreamClose output))))
         (def (truthStoreUploadArchiveLocal
                (archive : File)
@@ -17222,32 +17407,8 @@
        "    fun applyLearnedGuesses(session: SsdSession): Int ="
        "        truthStoreApplyLearnedGuessesLocal(this, session)"
        ""
-       "    fun exportZip(out: OutputStream) {"
-       "        storageStats()"
-       "        val limited = LimitedOutputStream(out, MAX_ZIP_TOTAL_BYTES)"
-       "        var entries = 0"
-       "        var sourceBytes = 0L"
-       "        ZipOutputStream(BufferedOutputStream(limited)).use { zip ->"
-       "            forEachFileUntil(listOf(groundTruthDir, learnedDir, eventsDir, reviewsDir)) { dir ->"
-       "                forEachRegularFileUnder(dir) { file ->"
-       "                    if (fileIsSymbolicLink(file)) throw IllegalStateException(\"Storage symlink rejected\")"
-       "                    entries += 1"
-       "                    sourceBytes += fileSizeBytes(file)"
-       "                    if (zipExportQuotaExceeded(entries, fileSizeBytes(file), sourceBytes, MAX_ZIP_ENTRIES, MAX_ZIP_ENTRY_BYTES, MAX_ZIP_TOTAL_BYTES)) {"
-       "                        throw IllegalStateException(\"ZIP export quota exceeded\")"
-       "                    }"
-       "                    val relative = root.toPath().relativize(file.toPath()).toString()"
-       "                    require(safeZipEntryName(relative)) { \"Unsafe local export path\" }"
-       "                    zip.putNextEntry(ZipEntry(relative))"
-       "                    file.inputStream().use { input ->"
-       "                        LimitedInputStream(input, MAX_ZIP_ENTRY_BYTES).use { it.copyTo(zip, 32 * 1024) }"
-       "                    }"
-       "                    zip.closeEntry()"
-       "                }"
-       "                true"
-       "            }"
-       "        }"
-       "    }"
+       "    fun exportZip(out: OutputStream) ="
+       "        truthStoreExportZipLocal(this, out)"
        ""
        "    fun importZip(input: InputStream): Int {"
        "        val stage = Files.createTempDirectory(context.cacheDir.toPath(), \"ssd-import-\").toFile()"