Add typed SSD server client
ober
912f3c624aabce849b3259970f1f9f87fb59de65
new file mode 100644 --- /dev/null +++ b/templates/ssd-review-parts/server-client.ss @@ -0,0 +1,435 @@ +(import (jerboa prelude)) + +(def fragment + '((typed-kotlin-file "com/sfb/ssdreview/SfbServerClient.kt" + (kotlin-imports (android content Context) + (org json JSONObject)) + (typed-library (com sfb ssdreview) + (export SfbServerClient sfbLanEndpointTexts) + (type Context) + (type Exception) + (type IllegalStateException) + (type Int32) + (type JSONObject) + (type SfbEndpoint) + (type SfbEndpointProbe) + (type SfbHttpTransport) + (type SfbServerCatalog) + (type SfbServerInfo) + (type SfbServerManifest) + (type SfbServerPageCatalog) + (type SfbServerPageTruth) + (type SfbServerPdf) + (type SfbServerRecognition) + (type SfbServerSnapshot) + (extern (sfbClientIllegalStateException + (message : String)) : IllegalStateException + (kotlin-call IllegalStateException)) + (extern (sfbClientUrlEncode (value : String)) : String + (kotlin-call urlEncode)) + (extern (sfbClientEndpointFromText + (value : String) + (bearerToken : String)) : SfbEndpoint + (kotlin-call sfbEndpointFromText)) + (extern (sfbClientEndpointLabel + (endpoint : SfbEndpoint)) : String + (kotlin-call sfbEndpointLabel)) + (extern (sfbClientEndpointLoopback + (endpoint : SfbEndpoint)) : Bool + (kotlin-call sfbEndpointLoopback)) + (extern (sfbClientEndpointAlreadyListed + (items : (List SfbEndpoint)) + (label : String)) : Bool + (kotlin-call sfbEndpointAlreadyListed)) + (extern (sfbClientEndpointCandidates + (base : SfbEndpoint) + (info : SfbServerInfo)) : (MutableList SfbEndpoint) + (kotlin-call sfbEndpointCandidates)) + (extern (sfbClientFastestEndpoint + (probes : (List SfbEndpointProbe))) : (Nullable SfbEndpoint) + (kotlin-call sfbFastestReachableEndpoint)) + (extern (sfbClientPageRequestValid + (pdfId : String) + (page : Int32) + (dpi : Int32)) : Bool + (kotlin-call sfbPageRequestValid)) + (extern (sfbClientEndpointProbe + (endpoint : SfbEndpoint) + (latencyMs : Int) + (reachable : Bool)) : SfbEndpointProbe + (kotlin-call SfbEndpointProbe)) + (extern (sfbClientProbeReachable + (probe : SfbEndpointProbe)) : Bool + (kotlin-member-get reachable)) + (extern (sfbClientInfoFromJson + (json : JSONObject)) : SfbServerInfo + (kotlin-call sfbServerInfoFromJson)) + (extern (sfbClientCatalogFromJson + (json : JSONObject)) : SfbServerCatalog + (kotlin-call sfbServerCatalogFromJson)) + (extern (sfbClientPagesFromJson + (pdfId : String) + (json : JSONObject)) : SfbServerPageCatalog + (kotlin-call sfbServerPagesFromJson)) + (extern (sfbClientManifestFromJson + (pdfId : String) + (page : Int32) + (dpi : Int32) + (json : JSONObject)) : SfbServerManifest + (kotlin-call sfbServerManifestFromJson)) + (extern (sfbClientTruthFromJson + (pdfId : String) + (page : Int32) + (dpi : Int32) + (json : JSONObject)) : SfbServerPageTruth + (kotlin-call sfbServerTruthFromJson)) + (extern (sfbClientRecognitionFromJson + (pdfId : String) + (page : Int32) + (dpi : Int32) + (recognition : JSONObject) + (ocr : (Nullable JSONObject))) : SfbServerRecognition + (kotlin-call sfbServerRecognitionFromJson)) + (extern (sfbClientFindPdf + (catalog : SfbServerCatalog) + (name : String)) : (Nullable SfbServerPdf) + (kotlin-call sfbFindServerPdfByName)) + (extern (sfbClientSnapshot + (pdfId : String) + (page : Int32) + (dpi : Int32) + (bytes : Bytes)) : SfbServerSnapshot + (kotlin-call SfbServerSnapshot)) + (extern (sfbClientRenderGeneration) : Int32 + (kotlin-value SFB_SERVER_RENDER_GENERATION)) + (extern (sfbClientFastConnectTimeout) : Int32 + (kotlin-value SFB_FAST_CONNECT_TIMEOUT_MS)) + (extern (sfbClientFastReadTimeout) : Int32 + (kotlin-value SFB_FAST_READ_TIMEOUT_MS)) + (extern (sfbClientPageConnectTimeout) : Int32 + (kotlin-value SFB_PAGE_CONNECT_TIMEOUT_MS)) + (extern (sfbClientPageReadTimeout) : Int32 + (kotlin-value SFB_PAGE_READ_TIMEOUT_MS)) + (extern (sfbClientMaxSnapshotBytes) : Int + (kotlin-value SFB_MAX_SNAPSHOT_BYTES)) + (extern (sfbClientNowMs) : Int + (kotlin-call java lang System currentTimeMillis)) + (extern (sfbTransportCurrentEndpoint + (transport : SfbHttpTransport)) : SfbEndpoint + (kotlin-member-call currentEndpoint)) + (extern (sfbTransportReplaceEndpoint + (transport : SfbHttpTransport) + (endpoint : SfbEndpoint)) : Unit + (kotlin-member-call replaceEndpoint)) + (extern (sfbTransportGetJsonAt + (transport : SfbHttpTransport) + (endpoint : SfbEndpoint) + (relative : String) + (connectTimeoutMs : Int32) + (readTimeoutMs : Int32) + (useCache : Bool)) : JSONObject + (kotlin-member-call getJsonAt)) + (extern (sfbTransportGetJsonCached + (transport : SfbHttpTransport) + (relative : String) + (connectTimeoutMs : Int32) + (readTimeoutMs : Int32)) : JSONObject + (kotlin-member-call getJsonCached)) + (extern (sfbTransportGetJsonUncached + (transport : SfbHttpTransport) + (relative : String) + (connectTimeoutMs : Int32) + (readTimeoutMs : Int32)) : JSONObject + (kotlin-member-call getJsonUncached)) + (extern (sfbTransportGetBytesCached + (transport : SfbHttpTransport) + (relative : String) + (maxBytes : Int) + (connectTimeoutMs : Int32) + (readTimeoutMs : Int32)) : Bytes + (kotlin-member-call getBytesCached)) + (def (sfbClientRequire (condition : Bool) (message : String)) : Unit + (if condition + (begin) + (throw (sfbClientIllegalStateException message) Unit))) + (def (sfbPageRelative (pdfId : String) + (page : Int32) + (leaf : String) + (dpi : Int32) + (rendered : Bool)) : String + (let ((base + (string-append + (string-append + (string-append + (string-append "ssd/" (sfbClientUrlEncode pdfId)) + "/") + (int32->string page)) + (string-append "/" leaf)))) + (if rendered + (string-append + (string-append base (string-append "?dpi=" (int32->string dpi))) + (string-append + "&render_generation=" + (int32->string (sfbClientRenderGeneration)))) + (string-append base (string-append "?dpi=" (int32->string dpi)))))) + (def (sfbProbeEndpoint (transport : SfbHttpTransport) + (endpoint : SfbEndpoint)) : SfbEndpointProbe + (let ((started (sfbClientNowMs))) + (try + (let ((health + (sfbTransportGetJsonAt + transport + endpoint + "health" + (sfbClientFastConnectTimeout) + (sfbClientFastReadTimeout) + #f))) + (sfbClientEndpointProbe + endpoint + (- (sfbClientNowMs) started) + (json-object-opt-bool-default health "ok" #f))) + (catch (error : Exception) + (sfbClientEndpointProbe endpoint (int 2147483647) #f))))) + (def (sfbProbeEndpoints (transport : SfbHttpTransport) + (endpoints : (List SfbEndpoint))) : (MutableList SfbEndpointProbe) + (for/fold ((out (mutable-list-empty SfbEndpointProbe))) + ((i (in-range (int32 0) (list-size endpoints)))) + (begin + (mutable-list-add! + out + (sfbProbeEndpoint transport (list-ref endpoints i))) + out))) + (def (sfbEndpointTextsToEndpoints + (values : (List String)) + (bearerToken : String)) : (MutableList SfbEndpoint) + (for/fold ((out (mutable-list-empty SfbEndpoint))) + ((i (in-range (int32 0) (list-size values)))) + (let ((endpoint + (try + (nullable-some + (sfbClientEndpointFromText (list-ref values i) bearerToken)) + (catch (error : Exception) + (nullable-none SfbEndpoint))))) + (begin + (if (nullable-null? endpoint) + (begin) + (let ((value (nullable-get endpoint))) + (if (sfbClientEndpointAlreadyListed out (sfbClientEndpointLabel value)) + (begin) + (mutable-list-add! out value)))) + out)))) + (def (sfbLanEndpointTexts (prefixes : (List String))) : (MutableList String) + (for/fold ((out (mutable-list-empty String))) + ((prefixIndex (in-range (int32 0) (list-size prefixes)))) + (let ((prefix (list-ref prefixes prefixIndex))) + (begin + (for/fold ((same out)) + ((hostPart (in-range (int32 1) (int32 255)))) + (begin + (mutable-list-add! + out + (string-append + (string-append + (string-append "http://" prefix) + ".") + (string-append + (int32->string hostPart) + ":8797/api"))) + same)) + out)))) + (class SfbServerClient + ((context : Context) + (endpointText : String) + (bearerToken : String (property val) (visibility private))) + (val transport : SfbHttpTransport + (new SfbHttpTransport + context + (sfbClientEndpointFromText endpointText bearerToken))) + (def (endpointLabel) : String + (sfbClientEndpointLabel + (sfbTransportCurrentEndpoint transport))) + (def (httpTransport) : SfbHttpTransport + transport) + (def (endpointIsLoopback) : Bool + (sfbClientEndpointLoopback + (sfbTransportCurrentEndpoint transport))) + (def (setEndpoint (value : String)) : Unit + (sfbTransportReplaceEndpoint + transport + (sfbClientEndpointFromText value bearerToken))) + (def (selectFastest + (candidates : (List SfbEndpoint))) : (Nullable SfbEndpoint) + (sfbClientFastestEndpoint + (sfbProbeEndpoints transport candidates))) + (def (discoverServerEndpoint + (candidateUrls : (List String))) : SfbServerInfo + (let ((candidates + (sfbEndpointTextsToEndpoints candidateUrls bearerToken))) + (let ((best (selectFastest candidates))) + (begin + (sfbClientRequire + (not (nullable-null? best)) + "No sfb-server answered at a discovery endpoint") + (sfbTransportReplaceEndpoint transport (nullable-get best)) + (fetchServerInfoUncached))))) + (def (refreshServerEndpoint) : SfbServerInfo + (let ((base (sfbTransportCurrentEndpoint transport))) + (let ((raw + (sfbTransportGetJsonAt + transport + base + "server-info" + (sfbClientPageConnectTimeout) + (sfbClientPageReadTimeout) + #f))) + (let ((info (sfbClientInfoFromJson raw))) + (let ((best + (selectFastest + (sfbClientEndpointCandidates base info)))) + (begin + (if (nullable-null? best) + (begin) + (sfbTransportReplaceEndpoint transport (nullable-get best))) + (if (or (nullable-null? best) + (equal? + (sfbClientEndpointLabel base) + (sfbClientEndpointLabel (nullable-get best)))) + info + (fetchServerInfoUncached)))))))) + (def (ensureReachableServerEndpoint + (allowLoopback : Bool)) : SfbServerInfo + (let ((current (sfbTransportCurrentEndpoint transport))) + (let ((probe (sfbProbeEndpoint transport current))) + (if (and (sfbClientProbeReachable probe) + (or allowLoopback (not (sfbClientEndpointLoopback current)))) + (fetchServerInfoUncached) + (throw + (sfbClientIllegalStateException + "Configured sfb-server endpoint is not reachable") + SfbServerInfo))))) + (def (fetchServerInfoUncached) : SfbServerInfo + (sfbClientInfoFromJson + (sfbTransportGetJsonUncached + transport + "server-info" + (sfbClientPageConnectTimeout) + (sfbClientPageReadTimeout)))) + (def (fetchServerInfo) : SfbServerInfo + (sfbClientInfoFromJson + (sfbTransportGetJsonCached + transport + "server-info" + (sfbClientPageConnectTimeout) + (sfbClientPageReadTimeout)))) + (def (fetchServerPdfs) : SfbServerCatalog + (sfbClientCatalogFromJson + (sfbTransportGetJsonCached + transport + "pdfs" + (sfbClientPageConnectTimeout) + (sfbClientPageReadTimeout)))) + (def (findServerPdfByName + (name : String)) : (Nullable SfbServerPdf) + (sfbClientFindPdf (fetchServerPdfs) name)) + (def (fetchServerPages + (pdfId : String)) : SfbServerPageCatalog + (begin + (sfbClientRequire + (not (string-blank? pdfId)) + "Server PDF id is required") + (sfbClientPagesFromJson + pdfId + (sfbTransportGetJsonCached + transport + (string-append + (string-append "pdf/" (sfbClientUrlEncode pdfId)) + "/pages") + (sfbClientPageConnectTimeout) + (sfbClientPageReadTimeout))))) + (def (fetchServerManifest + (pdfId : String) + (page : Int32) + (dpi : Int32)) : SfbServerManifest + (begin + (sfbClientRequire + (sfbClientPageRequestValid pdfId page dpi) + "Invalid sfb-server page request") + (sfbClientManifestFromJson + pdfId + page + dpi + (sfbTransportGetJsonCached + transport + (sfbPageRelative pdfId page "manifest" dpi #t) + (sfbClientPageConnectTimeout) + (sfbClientPageReadTimeout))))) + (def (fetchServerPageTruth + (pdfId : String) + (page : Int32) + (dpi : Int32)) : SfbServerPageTruth + (begin + (sfbClientRequire + (sfbClientPageRequestValid pdfId page dpi) + "Invalid sfb-server page request") + (sfbClientTruthFromJson + pdfId + page + dpi + (sfbTransportGetJsonUncached + transport + (sfbPageRelative pdfId page "truth" dpi #f) + (sfbClientPageConnectTimeout) + (sfbClientPageReadTimeout))))) + (def (fetchServerOcrJson + (pdfId : String) + (page : Int32) + (dpi : Int32)) : JSONObject + (begin + (sfbClientRequire + (sfbClientPageRequestValid pdfId page dpi) + "Invalid sfb-server OCR request") + (sfbTransportGetJsonCached + transport + (sfbPageRelative pdfId page "ocr" dpi #t) + (sfbClientPageConnectTimeout) + (sfbClientPageReadTimeout)))) + (def (fetchServerRecognition + (pdfId : String) + (page : Int32) + (dpi : Int32)) : SfbServerRecognition + (begin + (sfbClientRequire + (sfbClientPageRequestValid pdfId page dpi) + "Invalid sfb-server recognition request") + (let ((recognition + (sfbTransportGetJsonCached + transport + (sfbPageRelative pdfId page "recognition" dpi #t) + (sfbClientPageConnectTimeout) + (sfbClientPageReadTimeout)))) + (let ((ocr + (try + (nullable-some + (fetchServerOcrJson pdfId page dpi)) + (catch (error : Exception) + (nullable-none JSONObject))))) + (sfbClientRecognitionFromJson + pdfId page dpi recognition ocr))))) + (def (fetchServerSnapshot + (pdfId : String) + (page : Int32) + (dpi : Int32)) : SfbServerSnapshot + (begin + (sfbClientRequire + (sfbClientPageRequestValid pdfId page dpi) + "Invalid sfb-server snapshot request") + (sfbClientSnapshot + pdfId + page + dpi + (sfbTransportGetBytesCached + transport + (sfbPageRelative pdfId page "snapshot.png" dpi #t) + (sfbClientMaxSnapshotBytes) + (sfbClientPageConnectTimeout) + (sfbClientPageReadTimeout))))))))))