Add typed SSD server endpoint cache helpers
ober
c2c08ffefb6a159784e82a84778eb84f93b6f323
new file mode 100644 --- /dev/null +++ b/templates/ssd-review-parts/server-endpoint-cache.ss @@ -0,0 +1,265 @@ +(import (jerboa prelude)) + +(def fragment + '((typed-kotlin-file "com/sfb/ssdreview/SfbEndpointCache.kt" + (kotlin-imports (java io File) (java net URL)) + (typed-library (com sfb ssdreview) + (export make-SfbEndpoint SfbEndpoint? + SfbEndpoint-apiUrl SfbEndpoint-bearerToken + make-SfbEndpointProbe SfbEndpointProbe? + SfbEndpointProbe-endpoint SfbEndpointProbe-latencyMs + SfbEndpointProbe-reachable + make-SfbCachePolicy SfbCachePolicy? + SfbCachePolicy-ttlMs SfbCachePolicy-maxBytes + SfbCachePolicy-maxEntryBytes + SFB_DEFAULT_ENDPOINT SFB_SERVER_RENDER_GENERATION + SFB_FAST_CONNECT_TIMEOUT_MS SFB_FAST_READ_TIMEOUT_MS + SFB_PAGE_CONNECT_TIMEOUT_MS SFB_PAGE_READ_TIMEOUT_MS + SFB_CACHE_TTL_MS SFB_CACHE_MAX_BYTES + SFB_MAX_HTTP_TEXT_BYTES SFB_MAX_HTTP_COMPRESSED_BYTES + SFB_MAX_SNAPSHOT_BYTES SFB_MAX_APK_BYTES + sfbNormalizeEndpoint sfbEndpointFromText + sfbEndpointLabel sfbEndpointLoopback + sfbEndpointHttpAllowed sfbEndpointSafe + sfbEndpointAlreadyListed + sfbEndpointCandidates sfbFastestReachableEndpoint + sfbRelativePathSafe sfbPageRequestValid + sfbCachePolicyDefault sfbCacheFile sfbCacheFresh + sfbCacheOverBudget sfbCacheEntryAllowed + sfbAiJobIdValid sfbApkSha256Valid sfbApkDownloadRelative) + (type File) + (type Exception) + (type IllegalStateException) + (type Int32) + (type SfbServerAddress) + (type SfbServerInfo) + (type URL) + (extern (sfbIllegalStateException (message : String)) : IllegalStateException + (kotlin-call IllegalStateException)) + (extern (sfbUrl (value : String)) : URL + (kotlin-call URL)) + (extern (sfbUrlProtocol (url : URL)) : String + (kotlin-member-get protocol)) + (extern (sfbUrlHost (url : URL)) : String + (kotlin-member-get host)) + (extern (sfbUrlUserInfo (url : URL)) : (Nullable String) + (kotlin-member-get userInfo)) + (extern (sfbUrlQuery (url : URL)) : (Nullable String) + (kotlin-member-get query)) + (extern (sfbUrlRef (url : URL)) : (Nullable String) + (kotlin-member-get ref)) + (extern (sfbUrlToString (url : URL)) : String + (kotlin-member-call toString)) + (extern (sfbLocalHttpAllowed (host : String)) : Bool + (kotlin-call localTruthHttpAllowed)) + (extern (sfbSafeUrlParts + (userInfo : (Nullable String)) + (query : (Nullable String)) + (fragment : (Nullable String))) : Bool + (kotlin-call safeRemoteUrlParts)) + (extern (sfbBearerTokenValid (token : String)) : Bool + (kotlin-call remoteBearerTokenValid)) + (extern (sfbServerInfoAddresses + (info : SfbServerInfo)) : (List SfbServerAddress) + (kotlin-member-get addresses)) + (extern (sfbServerAddressUrl + (address : SfbServerAddress)) : String + (kotlin-member-get url)) + (extern (sfbEndpointTextUtf8Bytes (text : String)) : Bytes + (kotlin-call textUtf8Bytes)) + (extern (sfbEndpointSha256Hex (bytes : Bytes)) : String + (kotlin-call truthStoreSha256Hex)) + (extern (sfbFileLastModified (file : File)) : Int + (kotlin-member-call lastModified)) + (extern (sfbFileLength (file : File)) : Int + (kotlin-member-call length)) + (extern (sfbFileIsRegular (file : File)) : Bool + (kotlin-member-get isFile)) + (record SfbEndpoint + ((apiUrl : URL) + (bearerToken : String))) + (record SfbEndpointProbe + ((endpoint : SfbEndpoint) + (latencyMs : Int) + (reachable : Bool))) + (record SfbCachePolicy + ((ttlMs : Int) + (maxBytes : Int) + (maxEntryBytes : Int))) + (val SFB_DEFAULT_ENDPOINT : String + "http://127.0.0.1:8797/api" + (modifiers const)) + (val SFB_SERVER_RENDER_GENERATION : Int32 + (int32 3) + (modifiers const)) + (val SFB_FAST_CONNECT_TIMEOUT_MS : Int32 + (int32 900) + (modifiers const)) + (val SFB_FAST_READ_TIMEOUT_MS : Int32 + (int32 2500) + (modifiers const)) + (val SFB_PAGE_CONNECT_TIMEOUT_MS : Int32 + (int32 1200) + (modifiers const)) + (val SFB_PAGE_READ_TIMEOUT_MS : Int32 + (int32 9000) + (modifiers const)) + (val SFB_CACHE_TTL_MS : Int + (* (* (* (* (int 30) (int 24)) (int 60)) (int 60)) (int 1000)) + (modifiers const)) + (val SFB_CACHE_MAX_BYTES : Int + (* (* (* (int 2) (int 1024)) (int 1024)) (int 1024)) + (modifiers const)) + (val SFB_MAX_HTTP_TEXT_BYTES : Int + (* (* (int 32) (int 1024)) (int 1024)) + (modifiers const)) + (val SFB_MAX_HTTP_COMPRESSED_BYTES : Int + (* (* (int 8) (int 1024)) (int 1024)) + (modifiers const)) + (val SFB_MAX_SNAPSHOT_BYTES : Int + (* (* (int 32) (int 1024)) (int 1024)) + (modifiers const)) + (val SFB_MAX_APK_BYTES : Int + (* (* (int 256) (int 1024)) (int 1024)) + (modifiers const)) + (def (sfbNormalizeEndpoint (value : String)) : String + (let ((trimmed (string-trim value))) + (let ((base (if (string-blank? trimmed) SFB_DEFAULT_ENDPOINT trimmed))) + (let ((withScheme + (if (or (string-starts-with? base "http://") + (string-starts-with? base "https://")) + base + (string-append "http://" base)))) + (let ((stripped (string-replace-regex withScheme "/+$" ""))) + (if (string-ends-with? stripped "/api") + stripped + (string-append stripped "/api"))))))) + (def (sfbEndpointHttpAllowed (url : URL)) : Bool + (or (equal? (sfbUrlProtocol url) "https") + (and (equal? (sfbUrlProtocol url) "http") + (sfbLocalHttpAllowed (sfbUrlHost url))))) + (def (sfbEndpointSafe (url : URL)) : Bool + (and (not (string-blank? (sfbUrlHost url))) + (and (sfbEndpointHttpAllowed url) + (sfbSafeUrlParts + (sfbUrlUserInfo url) + (sfbUrlQuery url) + (sfbUrlRef url))))) + (def (sfbEndpointFromText (value : String) + (bearerToken : String)) : SfbEndpoint + (let ((url (sfbUrl (sfbNormalizeEndpoint value)))) + (if (and (sfbEndpointSafe url) (sfbBearerTokenValid bearerToken)) + (make-SfbEndpoint url bearerToken) + (throw + (sfbIllegalStateException "Unsafe sfb-server endpoint") + SfbEndpoint)))) + (def (sfbEndpointLabel (endpoint : SfbEndpoint)) : String + (sfbUrlToString (SfbEndpoint-apiUrl endpoint))) + (def (sfbEndpointLoopback (endpoint : SfbEndpoint)) : Bool + (let ((host (string-lowercase (sfbUrlHost (SfbEndpoint-apiUrl endpoint))))) + (or (or (equal? host "localhost") (equal? host "127.0.0.1")) + (equal? host "::1")))) + (def (sfbEndpointAlreadyListed (items : (List SfbEndpoint)) + (label : String)) : Bool + (for/fold ((found #f)) + ((i (in-range (int32 0) (list-size items)))) + (or found (equal? (sfbEndpointLabel (list-ref items i)) label)))) + (def (sfbEndpointCandidates (base : SfbEndpoint) + (info : SfbServerInfo)) : (MutableList SfbEndpoint) + (let ((out (mutable-list-empty SfbEndpoint))) + (begin + (mutable-list-add! out base) + (for/fold ((result out)) + ((i (in-range (int32 0) (list-size (sfbServerInfoAddresses info))))) + (let ((address (list-ref (sfbServerInfoAddresses info) i))) + (let ((candidate + (try + (nullable-some + (sfbEndpointFromText + (sfbServerAddressUrl address) + (SfbEndpoint-bearerToken base))) + (catch (error : Exception) + (nullable-none SfbEndpoint))))) + (begin + (if (nullable-null? candidate) + (begin) + (let ((endpoint (nullable-get candidate))) + (if (sfbEndpointAlreadyListed out (sfbEndpointLabel endpoint)) + (begin) + (mutable-list-add! out endpoint)))) + result))))))) + (def (sfbFastestReachableEndpoint + (probes : (List SfbEndpointProbe))) : (Nullable SfbEndpoint) + (let ((best + (for/fold ((current (nullable-none SfbEndpointProbe))) + ((i (in-range (int32 0) (list-size probes)))) + (let ((candidate (list-ref probes i))) + (if (not (SfbEndpointProbe-reachable candidate)) + current + (if (or (nullable-null? current) + (< (SfbEndpointProbe-latencyMs candidate) + (SfbEndpointProbe-latencyMs + (nullable-get current)))) + (nullable-some candidate) + current)))))) + (if (nullable-null? best) + (nullable-none SfbEndpoint) + (nullable-some + (SfbEndpointProbe-endpoint (nullable-get best)))))) + (def (sfbRelativePathSafe (relative : String)) : Bool + (and (not (string-blank? relative)) + (and (not (string-starts-with? relative "/")) + (and (not (string-contains? relative "\\")) + (and (not (string-contains? relative "..")) + (not (string-contains? relative "#"))))))) + (def (sfbPageRequestValid (pdfId : String) + (page : Int32) + (dpi : Int32)) : Bool + (and (and (not (string-blank? pdfId)) + (<= (string-length pdfId) 256)) + (and (and (>= page (int32 1)) (<= page (int32 10000))) + (and (>= dpi (int32 36)) (<= dpi (int32 1200)))))) + (def (sfbCachePolicyDefault) : SfbCachePolicy + (make-SfbCachePolicy + SFB_CACHE_TTL_MS + SFB_CACHE_MAX_BYTES + SFB_MAX_SNAPSHOT_BYTES)) + (def (sfbCacheFile (cacheDir : File) + (relative : String) + (suffix : String)) : File + (new File + cacheDir + (string-append + (sfbEndpointSha256Hex (sfbEndpointTextUtf8Bytes relative)) + suffix))) + (def (sfbCacheFresh (file : File) + (nowMs : Int) + (policy : SfbCachePolicy)) : Bool + (if (not (sfbFileIsRegular file)) + #f + (let ((age (- nowMs (sfbFileLastModified file)))) + (and (and (>= age (int 0)) (<= age (SfbCachePolicy-ttlMs policy))) + (<= (sfbFileLength file) (SfbCachePolicy-maxEntryBytes policy)))))) + (def (sfbCacheOverBudget (totalBytes : Int) + (policy : SfbCachePolicy)) : Bool + (> totalBytes (SfbCachePolicy-maxBytes policy))) + (def (sfbCacheEntryAllowed (bytes : Int) + (policy : SfbCachePolicy)) : Bool + (and (> bytes (int 0)) + (<= bytes (SfbCachePolicy-maxEntryBytes policy)))) + (def (sfbAiJobIdValid (jobId : String)) : Bool + (string-matches-regex? jobId "[A-Za-z0-9_-]{1,96}")) + (def (sfbApkSha256Valid (sha256 : String)) : Bool + (string-matches-regex? + (string-lowercase (string-trim sha256)) + "[0-9a-f]{64}")) + (def (sfbApkDownloadRelative (downloadUrl : String)) : (Nullable String) + (let ((relative + (string-trim + (string-remove-prefix + (string-replace-regex downloadUrl "^.*?/api/" "") + "/")))) + (if (and (string-starts-with? relative "apk/download?") + (sfbRelativePathSafe relative)) + (nullable-some relative) + (nullable-none String))))))))