Add typed SSD server HTTP transport
ober
f4de01febbea46611a9a27c988491a94a72032be
new file mode 100644 --- /dev/null +++ b/templates/ssd-review-parts/server-http.ss @@ -0,0 +1,504 @@ +(import (jerboa prelude)) + +(def fragment + '((typed-kotlin-file "com/sfb/ssdreview/SfbHttpTransport.kt" + (kotlin-imports (android content Context) + (java io File) + (java io InputStream) + (java io OutputStream) + (java net HttpURLConnection) + (java net URL) + (java net URLConnection) + (org json JSONObject)) + (typed-library (com sfb ssdreview) + (export SfbHttpTransport) + (type Context) + (type Exception) + (type File) + (type HttpURLConnection) + (type IllegalStateException) + (type InputStream) + (type Int32) + (type JSONObject) + (type OutputStream) + (type SfbCachePolicy) + (type SfbEndpoint) + (type URL) + (type URLConnection) + (extern (sfbHttpIllegalStateException + (message : String)) : IllegalStateException + (kotlin-call IllegalStateException)) + (extern (sfbHttpContextCacheDir (context : Context)) : File + (kotlin-member-get cacheDir)) + (extern (sfbHttpUrl (value : String)) : URL + (kotlin-call URL)) + (extern (sfbHttpUrlOpenConnection (url : URL)) : URLConnection + (kotlin-member-call openConnection)) + (extern (sfbHttpConnection (connection : URLConnection)) : HttpURLConnection + (kotlin-cast HttpURLConnection)) + (extern (sfbHttpRequestMethodSet + (connection : HttpURLConnection) + (method : String)) : Unit + (kotlin-member-set requestMethod)) + (extern (sfbHttpConnectTimeoutSet + (connection : HttpURLConnection) + (timeoutMs : Int32)) : Unit + (kotlin-member-set connectTimeout)) + (extern (sfbHttpReadTimeoutSet + (connection : HttpURLConnection) + (timeoutMs : Int32)) : Unit + (kotlin-member-set readTimeout)) + (extern (sfbHttpUseCachesSet + (connection : HttpURLConnection) + (enabled : Bool)) : Unit + (kotlin-member-set useCaches)) + (extern (sfbHttpDoOutputSet + (connection : HttpURLConnection) + (enabled : Bool)) : Unit + (kotlin-member-set doOutput)) + (extern (sfbHttpFixedLengthSet + (connection : HttpURLConnection) + (length : Int)) : Unit + (kotlin-member-call setFixedLengthStreamingMode)) + (extern (sfbHttpRequestPropertySet + (connection : HttpURLConnection) + (name : String) + (value : String)) : Unit + (kotlin-member-call setRequestProperty)) + (extern (sfbHttpResponseCode + (connection : HttpURLConnection)) : Int32 + (kotlin-member-get responseCode)) + (extern (sfbHttpInputStream + (connection : HttpURLConnection)) : InputStream + (kotlin-member-get inputStream)) + (extern (sfbHttpErrorStream + (connection : HttpURLConnection)) : (Nullable InputStream) + (kotlin-member-get errorStream)) + (extern (sfbHttpOutputStream + (connection : HttpURLConnection)) : OutputStream + (kotlin-member-get outputStream)) + (extern (sfbHttpContentEncoding + (connection : HttpURLConnection)) : (Nullable String) + (kotlin-member-get contentEncoding)) + (extern (sfbHttpContentLength + (connection : HttpURLConnection)) : Int + (kotlin-member-get contentLengthLong)) + (extern (sfbHttpDisconnect + (connection : HttpURLConnection)) : Unit + (kotlin-member-call disconnect)) + (extern (sfbHttpInputClose (input : InputStream)) : Unit + (kotlin-member-call close)) + (extern (sfbHttpOutputWrite + (output : OutputStream) + (bytes : Bytes)) : Unit + (kotlin-member-call write)) + (extern (sfbHttpOutputClose (output : OutputStream)) : Unit + (kotlin-member-call close)) + (extern (sfbHttpFileInputStream (file : File)) : InputStream + (kotlin-member-call inputStream)) + (extern (sfbHttpFileOutputStream (file : File)) : OutputStream + (kotlin-member-call outputStream)) + (extern (sfbHttpFileMkdirs (file : File)) : Bool + (kotlin-member-call mkdirs)) + (extern (sfbHttpFileListFiles (file : File)) : (Nullable (Array File)) + (kotlin-member-call listFiles)) + (extern (sfbHttpFileDelete (file : File)) : Bool + (kotlin-member-call delete)) + (extern (sfbHttpFileRenameTo (file : File) (target : File)) : Bool + (kotlin-member-call renameTo)) + (extern (sfbHttpFileName (file : File)) : String + (kotlin-member-get name)) + (extern (sfbHttpFileParent (file : File)) : (Nullable File) + (kotlin-member-get parentFile)) + (extern (sfbHttpFileLength (file : File)) : Int + (kotlin-member-call length)) + (extern (sfbHttpFileLastModified (file : File)) : Int + (kotlin-member-call lastModified)) + (extern (sfbHttpNowMs) : Int + (kotlin-call java lang System currentTimeMillis)) + (extern (sfbHttpJsonObject (text : String)) : JSONObject + (kotlin-call JSONObject)) + (extern (sfbHttpJsonToString (json : JSONObject)) : String + (kotlin-member-call toString)) + (extern (sfbHttpBytesSize (bytes : Bytes)) : Int32 + (kotlin-member-get size)) + (extern (sfbHttpTextUtf8Bytes (text : String)) : Bytes + (kotlin-call textUtf8Bytes)) + (extern (sfbHttpReadBoundedBytes + (input : InputStream) + (limit : Int)) : Bytes + (kotlin-call readBoundedBytes)) + (extern (sfbHttpLimitedInputStream + (input : InputStream) + (limit : Int)) : InputStream + (kotlin-call LimitedInputStream)) + (extern (sfbHttpResponseInputStream + (input : InputStream) + (contentEncoding : String)) : InputStream + (kotlin-call responseInputStream)) + (extern (sfbHttpFileIsSymbolicLink (file : File)) : Bool + (kotlin-call fileIsSymbolicLink)) + (extern (sfbHttpFileIsRegular (file : File)) : Bool + (kotlin-member-get isFile)) + (extern (sfbHttpEndpointLabel (endpoint : SfbEndpoint)) : String + (kotlin-call sfbEndpointLabel)) + (extern (sfbHttpEndpointBearerToken + (endpoint : SfbEndpoint)) : String + (kotlin-member-get bearerToken)) + (extern (sfbHttpRelativePathSafe (relative : String)) : Bool + (kotlin-call sfbRelativePathSafe)) + (extern (sfbHttpBearerTokenPresent (token : String)) : Bool + (kotlin-call remoteBearerTokenPresent)) + (extern (sfbHttpBearerHeader (token : String)) : String + (kotlin-call bearerAuthorizationHeader)) + (extern (sfbHttpCachePolicyDefault) : SfbCachePolicy + (kotlin-call sfbCachePolicyDefault)) + (extern (sfbHttpCacheFileFor + (cacheDir : File) + (relative : String) + (suffix : String)) : File + (kotlin-call sfbCacheFile)) + (extern (sfbHttpCacheFreshEntry + (file : File) + (nowMs : Int) + (policy : SfbCachePolicy)) : Bool + (kotlin-call sfbCacheFresh)) + (extern (sfbHttpCacheOverBudgetValue + (totalBytes : Int) + (policy : SfbCachePolicy)) : Bool + (kotlin-call sfbCacheOverBudget)) + (extern (sfbHttpCacheEntryAllowedValue + (bytes : Int) + (policy : SfbCachePolicy)) : Bool + (kotlin-call sfbCacheEntryAllowed)) + (extern (sfbHttpMaxCompressedBytes) : Int + (kotlin-value SFB_MAX_HTTP_COMPRESSED_BYTES)) + (extern (sfbHttpMaxTextBytes) : Int + (kotlin-value SFB_MAX_HTTP_TEXT_BYTES)) + (def (sfbHttpByteCount (bytes : Bytes)) : Int + (int (sfbHttpBytesSize bytes))) + (def (sfbHttpRequire (condition : Bool) (message : String)) : Unit + (if condition + (begin) + (throw (sfbHttpIllegalStateException message) Unit))) + (def (sfbHttpContentEncodingOrEmpty + (connection : HttpURLConnection)) : String + (let ((value (sfbHttpContentEncoding connection))) + (if (nullable-null? value) "" (nullable-get value)))) + (def (sfbHttpCloseError (connection : HttpURLConnection)) : Unit + (let ((input (sfbHttpErrorStream connection))) + (if (nullable-null? input) + (begin) + (sfbHttpInputClose (nullable-get input))))) + (def (sfbHttpCheckResponse (connection : HttpURLConnection)) : Unit + (let ((code (sfbHttpResponseCode connection))) + (if (or (< code (int32 200)) (> code (int32 299))) + (begin + (sfbHttpCloseError connection) + (throw + (sfbHttpIllegalStateException + (string-append "HTTP " (int32->string code))) + Unit)) + (begin)))) + (def (sfbHttpReadResponseBytes + (connection : HttpURLConnection) + (maxBytes : Int) + (allowGzip : Bool)) : Bytes + (begin + (sfbHttpRequire + (<= (sfbHttpContentLength connection) + (if allowGzip (sfbHttpMaxCompressedBytes) maxBytes)) + "sfb-server response exceeds declared byte limit") + (let ((raw (sfbHttpInputStream connection))) + (let ((limited + (sfbHttpLimitedInputStream + raw + (if allowGzip (sfbHttpMaxCompressedBytes) maxBytes)))) + (let ((input + (if allowGzip + (sfbHttpResponseInputStream + limited + (sfbHttpContentEncodingOrEmpty connection)) + limited))) + (try-finally + (sfbHttpReadBoundedBytes input maxBytes) + (sfbHttpInputClose input))))))) + (def (sfbHttpWriteBody + (connection : HttpURLConnection) + (bytes : Bytes)) : Unit + (let ((output (sfbHttpOutputStream connection))) + (try-finally + (sfbHttpOutputWrite output bytes) + (sfbHttpOutputClose output)))) + (def (sfbHttpReadCache + (file : File) + (maxBytes : Int)) : Bytes + (let ((input (sfbHttpFileInputStream file))) + (try-finally + (sfbHttpReadBoundedBytes input maxBytes) + (sfbHttpInputClose input)))) + (def (sfbHttpWriteCacheFile (file : File) (bytes : Bytes)) : Unit + (let ((parent (sfbHttpFileParent file))) + (begin + (sfbHttpRequire + (not (nullable-null? parent)) + "sfb-server cache entry has no parent") + (let ((temporary + (new File + (nullable-get parent) + (string-append (sfbHttpFileName file) ".tmp")))) + (begin + (if (sfbHttpFileIsSymbolicLink temporary) + (sfbHttpFileDelete temporary) + #f) + (let ((output (sfbHttpFileOutputStream temporary))) + (try-finally + (sfbHttpOutputWrite output bytes) + (sfbHttpOutputClose output))) + (sfbHttpRequire + (sfbHttpFileRenameTo temporary file) + "Unable to commit sfb-server cache entry")))))) + (def (sfbHttpFilesOrEmpty (dir : File)) : (MutableList File) + (let ((files (sfbHttpFileListFiles dir))) + (if (nullable-null? files) + (mutable-list-empty File) + (let ((source (nullable-get files))) + (for/fold ((out (mutable-list-empty File))) + ((i (in-range (int32 0) (list-size source)))) + (begin + (mutable-list-add! out (list-ref source i)) + out)))))) + (def (sfbHttpCacheTotalBytes (files : (List File))) : Int + (for/fold ((total (int 0))) + ((i (in-range (int32 0) (list-size files)))) + (let ((file (list-ref files i))) + (if (sfbHttpFileIsRegular file) + (+ total (sfbHttpFileLength file)) + total)))) + (def (sfbHttpOldestFile (files : (List File))) : (Nullable File) + (for/fold ((oldest (nullable-none File))) + ((i (in-range (int32 0) (list-size files)))) + (let ((candidate (list-ref files i))) + (if (not (sfbHttpFileIsRegular candidate)) + oldest + (if (or (nullable-null? oldest) + (< (sfbHttpFileLastModified candidate) + (sfbHttpFileLastModified (nullable-get oldest)))) + (nullable-some candidate) + oldest))))) + (def (sfbHttpPruneCache (dir : File) (policy : SfbCachePolicy)) : Unit + (let ((files (sfbHttpFilesOrEmpty dir))) + (let ((total (sfbHttpCacheTotalBytes files))) + (if (sfbHttpCacheOverBudgetValue total policy) + (let ((oldest (sfbHttpOldestFile files))) + (if (nullable-null? oldest) + (begin) + (begin + (sfbHttpFileDelete (nullable-get oldest)) + (sfbHttpPruneCache dir policy)))) + (begin))))) + (class SfbHttpTransport + ((context : Context) + (initialEndpoint : SfbEndpoint)) + (val cacheDir : File + (new File (sfbHttpContextCacheDir context) "sfb-server-cache")) + (val cachePolicy : SfbCachePolicy + (sfbHttpCachePolicyDefault)) + (var endpoint : SfbEndpoint initialEndpoint) + (init + (begin + (sfbHttpFileMkdirs cacheDir) + (begin))) + (def (endpointLabel) : String + (sfbHttpEndpointLabel endpoint)) + (def (currentEndpoint) : SfbEndpoint + endpoint) + (def (replaceEndpoint (value : SfbEndpoint)) : Unit + (set! endpoint value)) + (def (requestUrl (target : SfbEndpoint) + (relative : String)) : URL + (modifiers private) + (begin + (sfbHttpRequire + (sfbHttpRelativePathSafe relative) + "Unsafe sfb-server relative path") + (sfbHttpUrl + (string-append + (string-append (sfbHttpEndpointLabel target) "/") + relative)))) + (def (openConnection + (target : SfbEndpoint) + (relative : String) + (method : String) + (connectTimeoutMs : Int32) + (readTimeoutMs : Int32) + (acceptGzip : Bool)) : HttpURLConnection + (modifiers private) + (let ((connection + (sfbHttpConnection + (sfbHttpUrlOpenConnection + (requestUrl target relative))))) + (begin + (sfbHttpRequestMethodSet connection method) + (sfbHttpConnectTimeoutSet connection connectTimeoutMs) + (sfbHttpReadTimeoutSet connection readTimeoutMs) + (sfbHttpUseCachesSet connection #f) + (if acceptGzip + (sfbHttpRequestPropertySet connection "Accept-Encoding" "gzip") + (begin)) + (if (sfbHttpBearerTokenPresent (sfbHttpEndpointBearerToken target)) + (sfbHttpRequestPropertySet + connection + "Authorization" + (sfbHttpBearerHeader + (sfbHttpEndpointBearerToken target))) + (begin)) + connection))) + (def (getBytesAt + (target : SfbEndpoint) + (relative : String) + (maxBytes : Int) + (connectTimeoutMs : Int32) + (readTimeoutMs : Int32) + (useCache : Bool)) : Bytes + (let ((cacheKey + (string-append + (string-append (sfbHttpEndpointLabel target) "|") + relative))) + (let ((cache (sfbHttpCacheFileFor cacheDir cacheKey ".bin"))) + (if (and useCache + (sfbHttpCacheFreshEntry cache (sfbHttpNowMs) cachePolicy)) + (sfbHttpReadCache cache maxBytes) + (let ((connection + (openConnection + target + relative + "GET" + connectTimeoutMs + readTimeoutMs + #f))) + (try-finally + (begin + (sfbHttpCheckResponse connection) + (let ((bytes + (sfbHttpReadResponseBytes + connection + maxBytes + #f))) + (begin + (if (and useCache + (sfbHttpCacheEntryAllowedValue + (sfbHttpByteCount bytes) + cachePolicy)) + (begin + (sfbHttpWriteCacheFile cache bytes) + (sfbHttpPruneCache cacheDir cachePolicy)) + (begin)) + bytes))) + (sfbHttpDisconnect connection))))))) + (def (getJsonAt + (target : SfbEndpoint) + (relative : String) + (connectTimeoutMs : Int32) + (readTimeoutMs : Int32) + (useCache : Bool)) : JSONObject + (let ((cacheKey + (string-append + (string-append (sfbHttpEndpointLabel target) "|") + relative))) + (let ((cache (sfbHttpCacheFileFor cacheDir cacheKey ".json"))) + (if (and useCache + (sfbHttpCacheFreshEntry cache (sfbHttpNowMs) cachePolicy)) + (sfbHttpJsonObject + (utf8->string + (sfbHttpReadCache cache (sfbHttpMaxTextBytes)))) + (let ((connection + (openConnection + target + relative + "GET" + connectTimeoutMs + readTimeoutMs + #t))) + (try-finally + (begin + (sfbHttpCheckResponse connection) + (let ((bytes + (sfbHttpReadResponseBytes + connection + (sfbHttpMaxTextBytes) + #t))) + (begin + (if (and useCache + (sfbHttpCacheEntryAllowedValue + (sfbHttpByteCount bytes) + cachePolicy)) + (begin + (sfbHttpWriteCacheFile cache bytes) + (sfbHttpPruneCache cacheDir cachePolicy)) + (begin)) + (sfbHttpJsonObject (utf8->string bytes))))) + (sfbHttpDisconnect connection))))))) + (def (getJsonCached + (relative : String) + (connectTimeoutMs : Int32) + (readTimeoutMs : Int32)) : JSONObject + (getJsonAt + endpoint relative connectTimeoutMs readTimeoutMs #t)) + (def (getJsonUncached + (relative : String) + (connectTimeoutMs : Int32) + (readTimeoutMs : Int32)) : JSONObject + (getJsonAt + endpoint relative connectTimeoutMs readTimeoutMs #f)) + (def (getBytesCached + (relative : String) + (maxBytes : Int) + (connectTimeoutMs : Int32) + (readTimeoutMs : Int32)) : Bytes + (getBytesAt + endpoint relative maxBytes connectTimeoutMs readTimeoutMs #t)) + (def (getBytesUncached + (relative : String) + (maxBytes : Int) + (connectTimeoutMs : Int32) + (readTimeoutMs : Int32)) : Bytes + (getBytesAt + endpoint relative maxBytes connectTimeoutMs readTimeoutMs #f)) + (def (postJson + (relative : String) + (payload : JSONObject) + (connectTimeoutMs : Int32) + (readTimeoutMs : Int32)) : JSONObject + (let ((bytes (sfbHttpTextUtf8Bytes (sfbHttpJsonToString payload)))) + (begin + (sfbHttpRequire + (<= (sfbHttpByteCount bytes) (sfbHttpMaxTextBytes)) + "sfb-server POST payload exceeds byte limit") + (let ((connection + (openConnection + endpoint + relative + "POST" + connectTimeoutMs + readTimeoutMs + #t))) + (try-finally + (begin + (sfbHttpDoOutputSet connection #t) + (sfbHttpRequestPropertySet + connection + "Content-Type" + "application/json; charset=utf-8") + (sfbHttpFixedLengthSet + connection + (sfbHttpByteCount bytes)) + (sfbHttpWriteBody connection bytes) + (sfbHttpCheckResponse connection) + (sfbHttpJsonObject + (utf8->string + (sfbHttpReadResponseBytes + connection + (sfbHttpMaxTextBytes) + #t)))) + (sfbHttpDisconnect connection)))))))))))