Generate SSD pinned connections from typed Jerboa

ober

c7e3c844ef4eb24f5ed39043ad0fa6cdc3fe3fde

diff --git a/.build.yml b/.build.yml
index 7e0e092..f691172 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#dfb64812ae3c12e43f4b54253eaacd7c028bd5ff"
+  - "https://git.sr.ht/~lisp/jerboa#7938918c67d3ce73ea771c6daa98b2a01aa5de1c"
   # 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)" = dfb64812ae3c12e43f4b54253eaacd7c028bd5ff
-      test "$(git -C ../jerboa rev-parse 'HEAD^{tree}')" = d040cb9597be969071941ad645e932fcfc5618eb
+      test "$(git -C ../jerboa rev-parse HEAD)" = 7938918c67d3ce73ea771c6daa98b2a01aa5de1c
+      test "$(git -C ../jerboa rev-parse 'HEAD^{tree}')" = f8624291cadf9ae4dc2275d51a400f0c6041ab79
       JERBOA="chez --libdirs .:../jerboa/lib --script" make test
diff --git a/dependencies.lock.json b/dependencies.lock.json
index edb5364..c97c35f 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": "dfb64812ae3c12e43f4b54253eaacd7c028bd5ff",
-    "tree": "d040cb9597be969071941ad645e932fcfc5618eb"
+    "commit": "7938918c67d3ce73ea771c6daa98b2a01aa5de1c",
+    "tree": "f8624291cadf9ae4dc2275d51a400f0c6041ab79"
   },
   "assurance_tools": {
     "osv_scanner": {
diff --git a/scripts/verify-supply-chain.sh b/scripts/verify-supply-chain.sh
index 6f8d369..2668e2e 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=dfb64812ae3c12e43f4b54253eaacd7c028bd5ff # gitsafe:ignore
-jerboa_tree=d040cb9597be969071941ad645e932fcfc5618eb # gitsafe:ignore
+jerboa_commit=7938918c67d3ce73ea771c6daa98b2a01aa5de1c # gitsafe:ignore
+jerboa_tree=f8624291cadf9ae4dc2275d51a400f0c6041ab79 # 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 6ebdacc..c14ca73 100644
--- a/templates/ssd-review.ss
+++ b/templates/ssd-review.ss
@@ -15566,6 +15566,7 @@
                       (java io InputStream)
                       (java io OutputStream)
                       (java net URL)
+                      (java net URLConnection)
                       (java nio channels FileChannel)
                       (java nio file Files)
                       (java nio file LinkOption)
@@ -15573,13 +15574,17 @@
                       (java nio file StandardCopyOption)
                       (java nio file StandardOpenOption)
                       (java security MessageDigest)
+                      (java security PublicKey)
                       (java time Instant)
                       (java time OffsetDateTime)
                       (java time format DateTimeFormatter)
+                      (java security cert Certificate)
                       (java util zip ZipEntry)
                       (java util zip ZipInputStream)
                       (java util zip ZipOutputStream)
                       (javax net ssl HttpsURLConnection)
+                      (javax net ssl SSLPeerUnverifiedException)
+                      (javax net ssl SSLSocketFactory)
                       (androidx documentfile provider DocumentFile)
                       (org json JSONArray)
                       (org json JSONObject))
@@ -15594,6 +15599,7 @@
                 truthStoreAtomicWriteLocal
                 truthStoreLoadRemoteConfigLocal
                 truthStoreRemoteUrlLocal
+                truthStoreOpenPinnedConnectionLocal
                 truthStoreInvalidateTruthIndexLocal
                 truthStoreTruthIndexEntriesLocal
                 truthStoreTruthIndexEntryLocal
@@ -15629,6 +15635,7 @@
         (type Any)
         (type BufferedInputStream)
         (type BufferedOutputStream)
+        (type Certificate)
         (type Char)
         (type ContentResolver)
         (type Context)
@@ -15648,7 +15655,10 @@
         (type OffsetDateTime)
         (type OutputStream)
         (type Path)
+        (type PublicKey)
         (type RemoteConfig)
+        (type SSLPeerUnverifiedException)
+        (type SSLSocketFactory)
         (type SsdSession)
         (type SharedPreferences)
         (type StorageStats)
@@ -15658,6 +15668,7 @@
         (type TruthStore)
         (type Uri)
         (type URL)
+        (type URLConnection)
         (type JSONArray)
         (type JSONObject)
         (type ZipEntry)
@@ -15694,6 +15705,9 @@
         (extern (truthStoreReviewsDir
                   (store : TruthStore)) : File
           (kotlin-member-get reviewsDir))
+        (extern (truthStoreRemoteConfig
+                  (store : TruthStore)) : (Nullable RemoteConfig)
+          (kotlin-member-get remoteConfig))
         (extern (truthStoreTruthIndexCacheLoaded
                   (store : TruthStore)) : Bool
           (kotlin-member-get truthIndexCacheLoaded))
@@ -15735,6 +15749,10 @@
                   (contentType : (Nullable String))
                   (acceptGzip : Bool)) : HttpsURLConnection
           (kotlin-member-call openPinnedConnection))
+        (extern (truthStorePinnedSocketFactoryRaw
+                  (store : TruthStore)
+                  (config : RemoteConfig)) : SSLSocketFactory
+          (kotlin-member-call pinnedSocketFactory))
         (extern (truthStoreSaveTruthSnapshotRaw
                   (store : TruthStore)
                   (truth : JSONObject)) : File
@@ -15808,6 +15826,51 @@
         (extern (truthStoreConnectionInputStream
                   (connection : HttpsURLConnection)) : InputStream
           (kotlin-member-get inputStream))
+        (extern (truthStoreUrlOpenConnection
+                  (url : URL)) : URLConnection
+          (kotlin-member-call openConnection))
+        (extern (truthStoreHttpsConnection
+                  (connection : URLConnection)) : HttpsURLConnection
+          (kotlin-cast HttpsURLConnection))
+        (extern (truthStoreConnectionSslSocketFactorySet
+                  (connection : HttpsURLConnection)
+                  (factory : SSLSocketFactory)) : Unit
+          (kotlin-member-set sslSocketFactory))
+        (extern (truthStoreConnectionRequestMethodSet
+                  (connection : HttpsURLConnection)
+                  (method : String)) : Unit
+          (kotlin-member-set requestMethod))
+        (extern (truthStoreConnectionConnectTimeoutSet
+                  (connection : HttpsURLConnection)
+                  (timeout : Int32)) : Unit
+          (kotlin-member-set connectTimeout))
+        (extern (truthStoreConnectionReadTimeoutSet
+                  (connection : HttpsURLConnection)
+                  (timeout : Int32)) : Unit
+          (kotlin-member-set readTimeout))
+        (extern (truthStoreConnectionInstanceFollowRedirectsSet
+                  (connection : HttpsURLConnection)
+                  (enabled : Bool)) : Unit
+          (kotlin-member-set instanceFollowRedirects))
+        (extern (truthStoreConnectionDoOutputSet
+                  (connection : HttpsURLConnection)
+                  (enabled : Bool)) : Unit
+          (kotlin-member-set doOutput))
+        (extern (truthStoreConnectionSetRequestProperty
+                  (connection : HttpsURLConnection)
+                  (name : String)
+                  (value : String)) : Unit
+          (kotlin-member-call setRequestProperty))
+        (extern (truthStoreConnectionSetFixedLengthStreamingMode
+                  (connection : HttpsURLConnection)
+                  (length : Int)) : Unit
+          (kotlin-member-call setFixedLengthStreamingMode))
+        (extern (truthStoreConnectionConnect
+                  (connection : HttpsURLConnection)) : Unit
+          (kotlin-member-call connect))
+        (extern (truthStoreConnectionServerCertificates
+                  (connection : HttpsURLConnection)) : (Array Certificate)
+          (kotlin-member-get serverCertificates))
         (extern (truthStoreConnectionOutputStream
                   (connection : HttpsURLConnection)) : OutputStream
           (kotlin-member-get outputStream))
@@ -16078,6 +16141,15 @@
                   (digest : MessageDigest)
                   (bytes : Bytes)) : Bytes
           (kotlin-member-call digest))
+        (extern (truthStoreCertificatePublicKey
+                  (certificate : Certificate)) : PublicKey
+          (kotlin-member-get publicKey))
+        (extern (truthStorePublicKeyEncoded
+                  (key : PublicKey)) : Bytes
+          (kotlin-member-get encoded))
+        (extern (truthStoreSslPeerUnverifiedException
+                  (message : String)) : SSLPeerUnverifiedException
+          (kotlin-call SSLPeerUnverifiedException))
         (extern (truthStoreMaxZipEntryBytes) : Int
           (kotlin-value MAX_ZIP_ENTRY_BYTES))
         (extern (truthStoreMaxHttpTextBytes) : Int
@@ -16516,6 +16588,127 @@
                         basePort)
                       "Remote URL escaped configured HTTPS origin")
                     candidate))))))
+        (def (truthStoreConfigurePinnedConnectionLocal
+               (store : TruthStore)
+               (connection : HttpsURLConnection)
+               (config : RemoteConfig)
+               (method : String)
+               (outputBytes : (Nullable Int))
+               (contentType : (Nullable String))
+               (acceptGzip : Bool)) : Unit
+          (begin
+            (if (remoteConfigHasPin config)
+              (truthStoreConnectionSslSocketFactorySet
+                connection
+                (truthStorePinnedSocketFactoryRaw store config))
+              (begin))
+            (truthStoreConnectionRequestMethodSet connection method)
+            (truthStoreConnectionConnectTimeoutSet connection (int32 5000))
+            (truthStoreConnectionReadTimeoutSet connection (int32 30000))
+            (truthStoreConnectionInstanceFollowRedirectsSet
+              connection
+              #f)
+            (if (remoteBearerTokenPresent
+                  (RemoteConfig-bearerToken config))
+              (truthStoreConnectionSetRequestProperty
+                connection
+                "Authorization"
+                (bearerAuthorizationHeader
+                  (RemoteConfig-bearerToken config)))
+              (begin))
+            (truthStoreConnectionSetRequestProperty
+              connection
+              "Accept"
+              "application/json")
+            (if acceptGzip
+              (truthStoreConnectionSetRequestProperty
+                connection
+                "Accept-Encoding"
+                "gzip")
+              (begin))
+            (if (nullableTextPresent contentType)
+              (truthStoreConnectionSetRequestProperty
+                connection
+                "Content-Type"
+                (nullableTextOrEmpty contentType))
+              (begin))
+            (if (nullableByteCountPresent outputBytes)
+              (begin
+                (truthStoreRequired
+                  (nullableByteCountWithinLimit
+                    outputBytes
+                    (truthStoreMaxZipTotalBytes))
+                  "Upload exceeds byte limit")
+                (truthStoreConnectionDoOutputSet connection #t)
+                (truthStoreConnectionSetFixedLengthStreamingMode
+                  connection
+                  (nullableByteCountOrZero outputBytes)))
+              (begin))))
+        (def (truthStoreVerifyPinnedConnectionLocal
+               (connection : HttpsURLConnection)
+               (config : RemoteConfig)) : Unit
+          (if (remoteConfigHasPin config)
+            (let ((certificates
+                    (truthStoreConnectionServerCertificates connection)))
+              (begin
+                (if (nonPositiveCount (list-size certificates))
+                  (throw
+                    (truthStoreSslPeerUnverifiedException
+                      "Server provided no certificate")
+                    Unit)
+                  (begin))
+                (let ((certificate (list-ref certificates (int32 0))))
+                  (let ((actualPin
+                          (truthStoreMessageDigestDigest
+                            (truthStoreMessageDigestGetInstance
+                              "SHA-256")
+                            (truthStorePublicKeyEncoded
+                              (truthStoreCertificatePublicKey
+                                certificate)))))
+                    (if (constantTimeNullableBytesMismatch
+                          actualPin
+                          (RemoteConfig-spkiSha256 config))
+                      (begin
+                        (truthStoreConnectionDisconnect connection)
+                        (throw
+                          (truthStoreSslPeerUnverifiedException
+                            "SSD service identity pin mismatch")
+                          Unit))
+                      (begin))))))
+            (begin)))
+        (def (truthStoreOpenPinnedConnectionLocal
+               (store : TruthStore)
+               (relative : String)
+               (method : String)
+               (outputBytes : (Nullable Int)
+                 (default (nullable-none Int)))
+               (contentType : (Nullable String)
+                 (default (nullable-none String)))
+               (acceptGzip : Bool
+                 (default #f))) : HttpsURLConnection
+          (let ((config
+                  (truthStoreRemoteConfigOrThrow
+                    (truthStoreRemoteConfig store))))
+            (let ((connection
+                    (truthStoreHttpsConnection
+                      (truthStoreUrlOpenConnection
+                        (truthStoreRemoteUrlLocal
+                          (nullable-some config)
+                          relative)))))
+              (begin
+                (truthStoreConfigurePinnedConnectionLocal
+                  store
+                  connection
+                  config
+                  method
+                  outputBytes
+                  contentType
+                  acceptGzip)
+                (truthStoreConnectionConnect connection)
+                (truthStoreVerifyPinnedConnectionLocal
+                  connection
+                  config)
+                connection))))
         (def (truthStoreReadResponseTextLocal
                (connection : HttpsURLConnection)) : String
           (begin
@@ -18265,7 +18458,7 @@
        "    internal val learnedDir = File(root, \"learned\")"
        "    internal val eventsDir = File(root, \"events\")"
        "    internal val reviewsDir = File(root, \"reviews\")"
-       "    private val remoteConfig: RemoteConfig? by lazy { loadRemoteConfig() }"
+       "    internal val remoteConfig: RemoteConfig? by lazy { loadRemoteConfig() }"
        "    @Volatile internal var seedStarted = false"
        "    @Volatile internal var truthIndexCacheLoaded = false"
        "    @Volatile internal var truthIndexCache: MutableList<TruthIndexEntry> = ArrayList()"
@@ -18337,42 +18530,10 @@
        "        outputBytes: Long? = null,"
        "        contentType: String? = null,"
        "        acceptGzip: Boolean = false"
-       "    ): HttpsURLConnection {"
-       "        if (!remoteConfigPresent(remoteConfig)) throw IllegalStateException(\"Remote SSD service is not locally configured\")"
-       "        val config = checkNotNull(remoteConfig)"
-       "        val connection = (remoteUrl(relative).openConnection() as HttpsURLConnection).apply {"
-       "            if (remoteConfigHasPin(config)) {"
-       "                sslSocketFactory = pinnedSocketFactory(config)"
-       "            }"
-       "            requestMethod = method"
-       "            connectTimeout = 5000"
-       "            readTimeout = 30000"
-       "            instanceFollowRedirects = false"
-       "            if (remoteBearerTokenPresent(config.bearerToken)) setRequestProperty(\"Authorization\", bearerAuthorizationHeader(config.bearerToken))"
-       "            setRequestProperty(\"Accept\", \"application/json\")"
-       "            if (acceptGzip) setRequestProperty(\"Accept-Encoding\", \"gzip\")"
-       "            if (nullableTextPresent(contentType)) setRequestProperty(\"Content-Type\", nullableTextOrEmpty(contentType))"
-       "            if (nullableByteCountPresent(outputBytes)) {"
-       "                require(nullableByteCountWithinLimit(outputBytes, MAX_ZIP_TOTAL_BYTES)) { \"Upload exceeds byte limit\" }"
-       "                doOutput = true"
-       "                setFixedLengthStreamingMode(nullableByteCountOrZero(outputBytes))"
-       "            }"
-       "        }"
-       "        connection.connect()"
-       "        if (connection is HttpsURLConnection && remoteConfigHasPin(config)) {"
-       "            val certificates = connection.serverCertificates"
-       "            if (!positiveCount(certificates.size)) throw SSLPeerUnverifiedException(\"Server provided no certificate\")"
-       "            val certificate = certificates[0]"
-       "            val actualPin = MessageDigest.getInstance(\"SHA-256\").digest(certificate.publicKey.encoded)"
-       "            if (constantTimeNullableBytesMismatch(actualPin, config.spkiSha256)) {"
-       "                connection.disconnect()"
-       "                throw SSLPeerUnverifiedException(\"SSD service identity pin mismatch\")"
-       "            }"
-       "        }"
-       "        return connection"
-       "    }"
+       "    ): HttpsURLConnection ="
+       "        truthStoreOpenPinnedConnectionLocal(this, relative, method, outputBytes, contentType, acceptGzip)"
        ""
-       "    private fun pinnedSocketFactory(config: RemoteConfig): SSLSocketFactory {"
+       "    internal fun pinnedSocketFactory(config: RemoteConfig): SSLSocketFactory {"
        "        if (!remotePinBytesPresent(config.spkiSha256)) throw CertificateException(\"SPKI pin is required for pinned TLS\")"
        "        val expectedPin = checkNotNull(config.spkiSha256)"
        "        val managerFactory = TrustManagerFactory.getInstance(TrustManagerFactory.getDefaultAlgorithm())"
diff --git a/tests/ssd-security-test.sh b/tests/ssd-security-test.sh
index f414d58..5825cc2 100755
--- a/tests/ssd-security-test.sh
+++ b/tests/ssd-security-test.sh
@@ -49,9 +49,9 @@ reject_text() {
 require_text 'HttpsURLConnection'
 require_text 'X509TrustManager'
 require_generated_text 'MessageDigest.isEqual'
-require_text 'setRequestProperty("Authorization", bearerAuthorizationHeader(config.bearerToken))'
+require_generated_text 'setRequestProperty("Authorization", bearerAuthorizationHeader(config.bearerToken))'
 require_generated_text 'context.getSharedPreferences("ssd_review_remote", Context.MODE_PRIVATE)'
-require_text 'Remote SSD service is not locally configured'
+require_generated_text 'Remote SSD service is not locally configured'
 require_generated_text 'validatedSourceKey'
 require_generated_text 'truthStoreSha256Hex'
 require_generated_text 'textUtf8Bytes(key)'