Port Original Tactics ship labels to typed Jerboa
ober
11abd6f16ae2864e5c11fe456c4ea5601a2068f8
--- 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#7938918c67d3ce73ea771c6daa98b2a01aa5de1c" + - "https://git.sr.ht/~lisp/jerboa#3a1e213c984f40f16404f78007bbbccc925ec94a" # 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)" = 7938918c67d3ce73ea771c6daa98b2a01aa5de1c - test "$(git -C ../jerboa rev-parse 'HEAD^{tree}')" = f8624291cadf9ae4dc2275d51a400f0c6041ab79 + test "$(git -C ../jerboa rev-parse HEAD)" = 3a1e213c984f40f16404f78007bbbccc925ec94a + test "$(git -C ../jerboa rev-parse 'HEAD^{tree}')" = d1c285186e9618c88d0a89d61003816b126a3ef0 JERBOA="chez --libdirs .:../jerboa/lib --script" make test --- a/Makefile +++ b/Makefile @@ -4,6 +4,8 @@ CLIENT_BUILD_DIR ?= build/client EXAMPLE ?= examples/counter/app.ss CLIENT_EXAMPLE ?= examples/client/app.ss SSD_EXAMPLE ?= tests/fixtures/ssd-app.ss +ORIGINAL_TACTICS_EXAMPLE ?= tests/fixtures/original-tactics-app.ss +ORIGINAL_TACTICS_BUILD_DIR ?= build/original-tactics JAVA_HOME ?= /opt/homebrew/opt/openjdk@21/libexec/openjdk.jdk/Contents/Home ANDROID_HOME ?= $(HOME)/Library/Android/sdk ANDROID_SDK_ROOT ?= $(ANDROID_HOME) @@ -12,7 +14,7 @@ export ANDROID_HOME export ANDROID_SDK_ROOT export PATH := $(JAVA_HOME)/bin:/opt/homebrew/bin:$(PATH) -.PHONY: help clean generate test security supply-chain verify ssd-generate ssd-compile release-evidence apk +.PHONY: help clean generate test security supply-chain verify ssd-generate ssd-compile original-tactics-generate original-tactics-compile release-evidence apk .NOTPARALLEL: help: @@ -22,6 +24,7 @@ help: @echo " test Run generator, adversarial, SSD, and supply-chain tests" @echo " verify Run the release-required local verification suite" @echo " ssd-compile Compile the SSD fixture with pinned Gradle/JDK tools" + @echo " original-tactics-compile Compile the Original Tactics fixture with pinned Gradle/JDK tools" @echo " release-evidence Emit SBOM/provenance from a clean committed tree" @echo " clean Remove generated output" @@ -52,6 +55,9 @@ test: clean generate $(JERBOA) jandroid.ss generate tests/fixtures/typed-kotlin-app.ss build/typed-kotlin test -f build/typed-kotlin/app/src/main/java/org/jerboa/typedfixture/CounterModel.kt # gitsafe:ignore grep -q 'fun add_one(x: ULong): ULong' build/typed-kotlin/app/src/main/java/org/jerboa/typedfixture/CounterModel.kt # gitsafe:ignore + $(JERBOA) jandroid.ss generate $(ORIGINAL_TACTICS_EXAMPLE) $(ORIGINAL_TACTICS_BUILD_DIR) + test -f $(ORIGINAL_TACTICS_BUILD_DIR)/app/src/main/java/com/jerboa/originaltactics/ShipUiNames.kt + grep -q 'label.length <= maxChars' $(ORIGINAL_TACTICS_BUILD_DIR)/app/src/main/java/com/jerboa/originaltactics/ShipUiNames.kt $(MAKE) security $(MAKE) supply-chain @@ -79,5 +85,14 @@ ssd-compile: ssd-generate -I "$(CURDIR)/scripts/resolved-artifacts.init.gradle" \ -p build/ssd-security compileDebugKotlin writeResolvedRuntimeSbom writeResolvedBuildSbom +original-tactics-generate: clean + $(JERBOA) jandroid.ss generate $(ORIGINAL_TACTICS_EXAMPLE) $(ORIGINAL_TACTICS_BUILD_DIR) + +original-tactics-compile: original-tactics-generate + scripts/verify-android-sdk.sh + JDK_HOME=$$(scripts/verified-jdk.sh --home); \ + JAVA_HOME="$$JDK_HOME" scripts/verified-gradle.sh --no-daemon \ + -p $(ORIGINAL_TACTICS_BUILD_DIR) assembleDebug + release-evidence: scripts/release-evidence.sh --- a/dependencies.lock.json +++ b/dependencies.lock.json @@ -11,8 +11,8 @@ "generator_runtime": { "name": "jerboa", "repository": "https://git.sr.ht/~lisp/jerboa", - "commit": "7938918c67d3ce73ea771c6daa98b2a01aa5de1c", - "tree": "f8624291cadf9ae4dc2275d51a400f0c6041ab79" + "commit": "3a1e213c984f40f16404f78007bbbccc925ec94a", + "tree": "d1c285186e9618c88d0a89d61003816b126a3ef0" }, "assurance_tools": { "osv_scanner": { --- a/jandroid.ss +++ b/jandroid.ss @@ -207,6 +207,8 @@ (def (allow-backup spec) (entry-value (entries spec) 'allow-backup #f)) (def (uses-cleartext-traffic spec) (entry-value (entries spec) 'uses-cleartext-traffic #f)) (def (theme spec) (entry-value (entries spec) 'theme "@style/AppTheme")) +(def (activity-screen-orientation spec) (entry-value (entries spec) 'activity-screen-orientation #f)) +(def (activity-config-changes spec) (entry-value (entries spec) 'activity-config-changes #f)) (def (permissions spec) (entry-values (entries spec) 'permission)) (def (permission-forms spec) (entry-forms (entries spec) 'permission)) (def (dependencies spec) (entry-values (entries spec) 'dependency)) @@ -216,6 +218,7 @@ (def (kotlin-source-dirs spec) (entry-values (entries spec) 'kotlin-source-dir)) (def (raw-files spec) (entry-forms (entries spec) 'file)) (def (gradle-property-forms spec) (entry-forms (entries spec) 'gradle-property)) + (def (kotlin-file-entry? item) (and (pair? item) (or (eq? (car item) 'kotlin-file) @@ -621,7 +624,14 @@ " android:theme=\"" (xml-escape (theme spec)) "\">\n" " <activity\n" " android:name=\".MainActivity\"\n" - " android:exported=\"true\">\n" + " android:exported=\"true\"\n" + (if (activity-screen-orientation spec) + (string-append " android:screenOrientation=\"" (xml-escape (activity-screen-orientation spec)) "\"\n") + "") + (if (activity-config-changes spec) + (string-append " android:configChanges=\"" (xml-escape (activity-config-changes spec)) "\"\n") + "") + " >\n" " <intent-filter>\n" " <action android:name=\"android.intent.action.MAIN\" />\n" " <category android:name=\"android.intent.category.LAUNCHER\" />\n" --- 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=7938918c67d3ce73ea771c6daa98b2a01aa5de1c # gitsafe:ignore -jerboa_tree=f8624291cadf9ae4dc2275d51a400f0c6041ab79 # gitsafe:ignore +jerboa_commit=3a1e213c984f40f16404f78007bbbccc925ec94a # gitsafe:ignore +jerboa_tree=d1c285186e9618c88d0a89d61003816b126a3ef0 # gitsafe:ignore gradle_sha=20f1b1176237254a6fc204d8434196fa11a4cfb387567519c61556e8710aed78 jdk_macos_sha=8fa1eff40bb637a33613b2ccb8b12c70dc3661cc22cf8e784943715769a05336 jdk_linux_sha=d8afc263758141a66e0e3aafc321e783f7016696f4eaea067d340a269037d331 --- a/templates/original-tactics.ss +++ b/templates/original-tactics.ss @@ -7245,54 +7245,125 @@ " private const val PAIR_MARKER = \"$\" + \"pair\"" " }" "}")) - (kotlin-file-lines "com/jerboa/originaltactics/ShipUiNames.kt" - ("package com.jerboa.originaltactics" - "" - "import org.json.JSONObject" - "" - "private val RAW_SSD_ID = Regex(\"^ssd-[0-9a-f]+-p\\\\d+-d\\\\d+$\", RegexOption.IGNORE_CASE)" - "" - "fun shipDisplayLabel(ship: JSONObject?, fallback: String = \"-\"): String {" - " if (ship == null) return fallback" - " val properties = ship.optJSONObject(\"properties\")" - " val candidates = listOf(" - " properties?.optString(\"display-name\", \"\")," - " ship.optString(\"display-name\", \"\")," - " ship.optString(\"name\", \"\")," - " properties?.optString(\"title-candidate\", \"\")," - " properties?.optString(\"ship-type\", \"\")" - " )" - " return candidates" - " .map { it?.trim().orEmpty() }" - " .firstOrNull { it.isNotBlank() && !RAW_SSD_ID.matches(it) }" - " ?: fallback" - "}" - "" - "fun shortShipDisplayLabel(ship: JSONObject?, maxChars: Int = 16, fallback: String = \"-\"): String {" - " val label = shipDisplayLabel(ship, fallback)" - " return if (label.length <= maxChars) label else label.take(maxChars - 1).trimEnd() + \"...\"" - "}" - "" - "fun shipTechnicalLabel(ship: JSONObject?, fallback: String = \"-\"): String {" - " if (ship == null) return fallback" - " val properties = ship.optJSONObject(\"properties\")" - " val source = properties?.optString(\"source\", \"\")?.trim().orEmpty()" - " val module = properties?.optString(\"source-module\", \"\")?.trim().orEmpty()" - " val type = properties?.optString(\"ship-type\", \"\")?.trim().orEmpty()" - " val page = properties?.optInt(\"source-page\", 0) ?: 0" - " if (source == \"ssd-truth\") {" - " val base = listOf(module, type).filter { it.isNotBlank() }.joinToString(\" \")" - " return when {" - " base.isNotBlank() && page > 0 -> \"$base p$page\"" - " base.isNotBlank() -> base" - " page > 0 -> \"SSD p$page\"" - " else -> shortShipDisplayLabel(ship, 18, fallback)" - " }" - " }" - " val id = ship.optString(\"template-id\", \"\").trim()" - " if (id.isNotBlank() && !RAW_SSD_ID.matches(id)) return id.uppercase()" - " return shortShipDisplayLabel(ship, 18, fallback)" - "}")) + (typed-kotlin-file "com/jerboa/originaltactics/ShipUiNames.kt" + (kotlin-imports (org json JSONObject)) + (typed-library (com jerboa originaltactics) + (export shipDisplayLabel shortShipDisplayLabel shipTechnicalLabel) + (type Int32) + (type JSONObject) + (def (shipRawSsdId? (text : String)) : Bool + (string-matches-regex? + (string-lowercase text) + "^ssd-[0-9a-f]+-p\\d+-d\\d+$")) + (def (shipUsableLabel? (text : String)) : Bool + (and (not (string-blank? text)) + (not (shipRawSsdId? text)))) + (def (shipNullableText + (json : (Nullable JSONObject)) + (key : String)) : String + (if (nullable-null? json) + "" + (string-trim + (json-object-opt-string-default + (nullable-get json) + key + "")))) + (def (shipText (json : JSONObject) (key : String)) : String + (string-trim (json-object-opt-string-default json key ""))) + (def (shipFirstUsableLabel + (fallback : String) + (first : String) + (second : String) + (third : String) + (fourth : String) + (fifth : String)) : String + (if (shipUsableLabel? first) + first + (if (shipUsableLabel? second) + second + (if (shipUsableLabel? third) + third + (if (shipUsableLabel? fourth) + fourth + (if (shipUsableLabel? fifth) + fifth + fallback)))))) + (def (shipDisplayLabel + (ship : (Nullable JSONObject)) + (fallback : String (default "-"))) : String + (if (nullable-null? ship) + fallback + (let ((json (nullable-get ship))) + (let ((properties (json-object-opt-json-object json "properties"))) + (shipFirstUsableLabel + fallback + (shipNullableText properties "display-name") + (shipText json "display-name") + (shipText json "name") + (shipNullableText properties "title-candidate") + (shipNullableText properties "ship-type")))))) + (def (shortShipDisplayLabel + (ship : (Nullable JSONObject)) + (maxChars : Int32 (default (int32 16))) + (fallback : String (default "-"))) : String + (let ((label (shipDisplayLabel ship fallback))) + (if (<= (string-length-int32 label) maxChars) + label + (string-append + (string-trim-end + (string-take label (- maxChars (int32 1)))) + "...")))) + (def (shipTypeSourceBase + (module : String) + (type : String)) : String + (if (string-blank? module) + type + (if (string-blank? type) + module + (string-append module (string-append " " type))))) + (def (shipTruthTechnicalLabel + (ship : (Nullable JSONObject)) + (base : String) + (page : Int32) + (fallback : String)) : String + (if (and (not (string-blank? base)) (> page (int32 0))) + (string-append base (string-append " p" (int32->string page))) + (if (not (string-blank? base)) + base + (if (> page (int32 0)) + (string-append "SSD p" (int32->string page)) + (shortShipDisplayLabel ship (int32 18) fallback))))) + (def (shipTechnicalLabel + (ship : (Nullable JSONObject)) + (fallback : String (default "-"))) : String + (if (nullable-null? ship) + fallback + (let ((json (nullable-get ship))) + (let ((properties (json-object-opt-json-object json "properties"))) + (let ((source (shipNullableText properties "source")) + (module (shipNullableText properties "source-module")) + (type (shipNullableText properties "ship-type")) + (page + (if (nullable-null? properties) + (int32 0) + (json-object-opt-int32-default + (nullable-get properties) + "source-page" + (int32 0))))) + (if (equal? source "ssd-truth") + (shipTruthTechnicalLabel + ship + (shipTypeSourceBase module type) + page + fallback) + (let ((id (shipText json "template-id"))) + (if (and (not (string-blank? id)) + (not (shipRawSsdId? id))) + (string-uppercase id) + (shortShipDisplayLabel + ship + (int32 18) + fallback))))))))))) (kotlin-file-lines "com/jerboa/originaltactics/SsdDamageView.kt" ("package com.jerboa.originaltactics" "" new file mode 100644 --- /dev/null +++ b/tests/fixtures/original-tactics-app.ss @@ -0,0 +1,14 @@ +(import (jerboa prelude)) + +(def app + '(android-app + (id "com.jerboa.originaltactics") + (name "Original Tactics") + (compile-sdk 36) + (min-sdk 26) + (target-sdk 36) + (uses-cleartext-traffic #t) + (activity-screen-orientation "landscape") + (activity-config-changes "keyboardHidden|orientation|screenSize") + (client original-tactics) + (screen Main (text "Original Tactics"))))