From 841b4cad494acc30cb50b50fb34710206568b7ae Mon Sep 17 00:00:00 2001 From: Paul Biggar Date: Wed, 23 Feb 2022 20:18:37 +0000 Subject: [PATCH 1/7] Do most of the porting work --- .../src/BackendOnlyStdLib/LibStaticAssets.fs | 806 ++++++++---------- fsharp-backend/src/LibBackend/StaticAssets.fs | 61 +- 2 files changed, 361 insertions(+), 506 deletions(-) diff --git a/fsharp-backend/src/BackendOnlyStdLib/LibStaticAssets.fs b/fsharp-backend/src/BackendOnlyStdLib/LibStaticAssets.fs index f671e24de8..e6185fecd1 100644 --- a/fsharp-backend/src/BackendOnlyStdLib/LibStaticAssets.fs +++ b/fsharp-backend/src/BackendOnlyStdLib/LibStaticAssets.fs @@ -3,7 +3,9 @@ module BackendOnlyStdLib.LibStaticAssets open LibExecution.RuntimeTypes open Prelude +open LibExecution.RuntimeTypes +module SA = LibBackend.StaticAssets module Errors = LibExecution.Errors let fn = FQFnName.stdlibFnName @@ -15,476 +17,334 @@ let incorrectArgs = LibExecution.Errors.incorrectArgs let varA = TVariable "a" let varB = TVariable "b" -let fns : List = [] -// [ { name = fn "StaticAssets" "baseUrlFor" 0 -// -// ; parameters = [Param.make "deploy_hash" TStr ""] -// ; returnType = TStr -// ; description = "Return the baseUrl for the specified deploy hash" -// ; fn = -// (function -// | state, [DStr deploy_hash] -> -// url state.canvas_id (Unicode_string.to_string deploy_hash) `Short -// |> DStr -// | _ -> -// Libexecution.Lib.incorrectArgs ()) -// ; sqlSpec = NotYetImplementedTODO -// ; previewable = Impure -// ; deprecated = NotDeprecated } -// ; { name = fn "StaticAssets" "baseUrlForLatest" 0 -// ; parameters = [] -// ; returnType = TStr -// ; description = "Return the baseUrl for the latest deploy" -// ; fn = -// (function -// | state, [] -> -// url state.canvas_id (latest_deploy_hash state.canvas_id) `Short -// |> DStr -// | _ -> -// Libexecution.Lib.incorrectArgs ()) -// ; sqlSpec = NotYetImplementedTODO -// ; previewable = Impure -// ; deprecated = NotDeprecated } -// ; { name = fn "StaticAssets" "urlFor" 0 -// ; parameters = [Param.make "deploy_hash" TStr ""; Param.make "file" TStr ""] -// ; returnType = TStr -// ; description = "Return a url for the specified file and deploy hash" -// ; fn = -// (function -// | state, [DStr deploy_hash; DStr file] -> -// url_for -// state.canvas_id -// (Unicode_string.to_string deploy_hash) -// `Short -// (Unicode_string.to_string file) -// |> DStr -// | _ -> -// Libexecution.Lib.incorrectArgs ()) -// ; sqlSpec = NotYetImplementedTODO -// ; previewable = Impure -// ; deprecated = NotDeprecated } -// ; { name = fn "StaticAssets" "urlForLatest" 0 -// ; parameters = [Param.make "file" TStr ""] -// ; returnType = TStr -// ; description = "Return a url for the specified file and latest deploy" -// ; fn = -// (function -// | state, [DStr file] -> -// url_for -// state.canvas_id -// (latest_deploy_hash state.canvas_id) -// `Short -// (Unicode_string.to_string file) -// |> DStr -// | _ -> -// Libexecution.Lib.incorrectArgs ()) -// ; sqlSpec = NotYetImplementedTODO -// ; previewable = Impure -// ; deprecated = NotDeprecated } -// ; { name = fn "StaticAssets" "fetch" 0 -// ; parameters = [Param.make "deploy_hash" TStr ""; Param.make "file" TStr ""] -// ; returnType = TResult -// ; description = -// "Return the specified file from the deploy_hash - only works on UTF8-safe files for now" -// ; fn = -// (function -// | state, [DStr deploy_hash; DStr file] -> -// let url = -// url_for -// state.canvas_id -// (Unicode_string.to_string deploy_hash) -// `Short -// (Unicode_string.to_string file) -// in -// let response = -// Legacy.HttpclientV0.call url Httpclient.GET [] "" -// |> Dval.dstr_of_string -// in -// ( match response with -// | Some dv -> -// DResult (Ok dv) -// | None -> -// DResult -// (ResError -// (DStr "Response was not -// UTF-8 safe")) -// ) -// | _ -> -// Libexecution.Lib.incorrectArgs ()) -// ; sqlSpec = NotYetImplementedTODO -// ; previewable = Impure -// ; deprecated = ReplacedBy(fn "" "" 0) } -// ; { name = fn "StaticAssets" "fetch" 1 -// ; parameters = [Param.make "deploy_hash" TStr ""; Param.make "file" TStr ""] -// ; returnType = TResult -// ; description = -// "Return the specified file from the deploy_hash - only works on UTF8-safe files for now" -// ; fn = -// (function -// | state, [DStr deploy_hash; DStr file] -> -// let url = -// url_for -// state.canvas_id -// (Unicode_string.to_string deploy_hash) -// `Short -// (Unicode_string.to_string file) -// in -// let response = -// Legacy.HttpclientV0.call url Httpclient.GET [] "" -// |> Dval.dstr_of_string -// in -// ( match response with -// | Some dv -> -// Dval.to_res_ok dv -// | None -> -// Dval.to_res_err -// (DStr "Response was not UTF-8 safe") ) -// | _ -> -// Libexecution.Lib.incorrectArgs ()) -// ; sqlSpec = NotYetImplementedTODO -// ; previewable = Impure -// ; deprecated = NotDeprecated } -// ; { name = fn "StaticAssets" "fetchBytes" 0 -// ; parameters = [Param.make "deploy_hash" TStr ""; Param.make "file" TStr ""] -// ; returnType = TResult -// ; description = -// "Return the bytes of the specified file from the deploy_hash" -// ; fn = -// (function -// | state, [DStr deploy_hash; DStr file] -> -// let url = -// url_for -// state.canvas_id -// (Unicode_string.to_string deploy_hash) -// `Short -// (Unicode_string.to_string file) -// in -// let response = -// Legacy.HttpclientV1.call -// ~raw_bytes:true -// url -// Httpclient.GET -// [] -// "" -// in -// DResult (Ok (DBytes (response |> RawBytes.of_string))) -// | _ -> -// Libexecution.Lib.incorrectArgs ()) -// ; sqlSpec = NotYetImplementedTODO -// ; previewable = Impure -// ; deprecated = NotDeprecated } -// ; { name = fn "StaticAssets" "fetchLatest" 0 -// ; parameters = [Param.make "file" TStr ""] -// ; returnType = TResult -// ; description = -// "Return the specified file from the latest deploy - only works on UTF8-safe files for now" -// ; fn = -// (function -// | state, [DStr file] -> -// let url = -// url_for -// state.canvas_id -// (latest_deploy_hash state.canvas_id) -// `Short -// (Unicode_string.to_string file) -// in -// let response = -// Legacy.HttpclientV0.call url Httpclient.GET [] "" -// |> Dval.dstr_of_string -// in -// ( match response with -// | Some dv -> -// DResult (Ok dv) -// | None -> -// DResult -// (ResError -// (DStr "Response was not -// UTF-8 safe")) -// ) -// | _ -> -// Libexecution.Lib.incorrectArgs ()) -// ; sqlSpec = NotYetImplementedTODO -// ; previewable = Impure -// ; deprecated = ReplacedBy(fn "" "" 0) } -// ; { name = fn "StaticAssets" "fetchLatest" 1 -// ; parameters = [Param.make "file" TStr ""] -// ; returnType = TResult -// ; description = -// "Return the specified file from the latest deploy - only works on UTF8-safe files for now" -// ; fn = -// (function -// | state, [DStr file] -> -// let url = -// url_for -// state.canvas_id -// (latest_deploy_hash state.canvas_id) -// `Short -// (Unicode_string.to_string file) -// in -// let response = -// Legacy.HttpclientV0.call url Httpclient.GET [] "" -// |> Dval.dstr_of_string -// in -// ( match response with -// | Some dv -> -// Dval.to_res_ok dv -// | None -> -// Dval.to_res_err -// (DStr "Response was not -// UTF-8 safe") ) -// | _ -> -// Libexecution.Lib.incorrectArgs ()) -// ; sqlSpec = NotYetImplementedTODO -// ; previewable = Impure -// ; deprecated = NotDeprecated } -// ; { name = fn "StaticAssets" "fetchLatestBytes" 0 -// ; parameters = [Param.make "file" TStr ""] -// ; returnType = TResult -// ; description = -// "Return the bytes of the specified file from the latest deploy" -// ; fn = -// (function -// | state, [DStr file] -> -// let url = -// url_for -// state.canvas_id -// (latest_deploy_hash state.canvas_id) -// `Short -// (Unicode_string.to_string file) -// in -// let response = -// Legacy.HttpclientV1.call -// ~raw_bytes:true -// url -// Httpclient.GET -// [] -// "" -// in -// DResult (Ok (DBytes (response |> RawBytes.of_string))) -// | _ -> -// Libexecution.Lib.incorrectArgs ()) -// ; sqlSpec = NotYetImplementedTODO -// ; previewable = Impure -// ; deprecated = NotDeprecated } -// ; { name = fn "StaticAssets" "serve" 0 -// ; parameters = [Param.make "deploy_hash" TStr ""; Param.make "file" TStr ""] -// ; returnType = TResult -// ; description = -// "Return the specified file from the latest deploy - only works on UTF8-safe files for now" -// ; fn = -// (function -// | state, [DStr deploy_hash; DStr file] -> -// let url = -// url_for -// state.canvas_id -// (Unicode_string.to_string deploy_hash) -// `Short -// (Unicode_string.to_string file) -// in -// let body, code, headers, _erroreturnType = -// Legacy.HttpclientV2.http_call_with_code -// url -// [] -// Httpclient.GET -// [] -// "" -// in -// let headers = -// headers -// |> List.map (fun (k, v) -> (k, String.trim v)) -// |> List.filter (fun (k, v) -> -// not -// (Core_kernel.String.is_substring -// k -// "Content-Length")) -// |> List.filter (fun (k, v) -> -// not -// (Core_kernel.String.is_substring -// k -// "Transfer-Encoding")) -// |> List.filter (fun (k, v) -> -// not -// (Core_kernel.String.is_substring -// k -// "Cache-Control")) -// |> List.filter (fun (k, v) -> not (String.trim k = "")) -// |> List.filter (fun (k, v) -> not (String.trim v = "")) -// in -// let body = Dval.dstr_of_string body in -// ( match body with -// | Some dv -> -// DResult (Ok (DResp (Response (code, headers), dv))) -// | None -> -// DResult -// (ResError -// (DStr "Response was not UTF-8 safe")) -// ) -// | _ -> -// Libexecution.Lib.incorrectArgs ()) -// ; sqlSpec = NotYetImplementedTODO -// ; previewable = Impure -// ; deprecated = ReplacedBy(fn "" "" 0) } -// ; { name = fn "StaticAssets" "serve" 1 -// ; parameters = [Param.make "deploy_hash" TStr ""; Param.make "file" TStr ""] -// ; returnType = TResult -// ; description = "Return the specified file from the latest deploy" -// ; fn = -// (function -// | state, [DStr deploy_hash; DStr file] -> -// let url = -// url_for -// state.canvas_id -// (Unicode_string.to_string deploy_hash) -// `Short -// (Unicode_string.to_string file) -// in -// let body, code, headers, _erroreturnType = -// Legacy.HttpclientV2.http_call_with_code -// ~raw_bytes:true -// url -// [] -// Httpclient.GET -// [] -// "" -// in -// let headers = -// headers -// |> List.map (fun (k, v) -> (k, String.trim v)) -// |> List.filter (fun (k, v) -> -// not -// (Core_kernel.String.is_substring -// k -// "Content-Length")) -// |> List.filter (fun (k, v) -> -// not -// (Core_kernel.String.is_substring -// k -// "Transfer-Encoding")) -// |> List.filter (fun (k, v) -> -// not -// (Core_kernel.String.is_substring -// k -// "Cache-Control")) -// |> List.filter (fun (k, v) -> not (String.trim k = "")) -// |> List.filter (fun (k, v) -> not (String.trim v = "")) -// in -// DResult -// (Ok -// (DResp -// ( Response (code, headers) -// , DBytes (body |> RawBytes.of_string) ))) -// | _ -> -// Libexecution.Lib.incorrectArgs ()) -// ; sqlSpec = NotYetImplementedTODO -// ; previewable = Impure -// ; deprecated = NotDeprecated } -// ; { name = fn "StaticAssets" "serveLatest" 0 -// ; parameters = [Param.make "file" TStr ""] -// ; returnType = TResult -// ; description = -// "Return the specified file from the latest deploy - only works on UTF8-safe files for now" -// ; fn = -// (function -// | state, [DStr file] -> -// let url = -// url_for -// state.canvas_id -// (latest_deploy_hash state.canvas_id) -// `Short -// (Unicode_string.to_string file) -// in -// let body, code, headers, _erroreturnType = -// Legacy.HttpclientV2.http_call_with_code -// ~raw_bytes:true -// url -// [] -// Httpclient.GET -// [] -// "" -// in -// let headers = -// headers -// |> List.map (fun (k, v) -> (k, String.trim v)) -// |> List.filter (fun (k, v) -> -// not -// (Core_kernel.String.is_substring -// k -// "Content-Length")) -// |> List.filter (fun (k, v) -> -// not -// (Core_kernel.String.is_substring -// k -// "Transfer-Encoding")) -// |> List.filter (fun (k, v) -> -// not -// (Core_kernel.String.is_substring -// k -// "Cache-Control")) -// |> List.filter (fun (k, v) -> not (String.trim k = "")) -// |> List.filter (fun (k, v) -> not (String.trim v = "")) -// in -// DResult -// (Ok -// (DResp -// ( Response (code, headers) -// , DBytes (body |> RawBytes.of_string) ))) -// | _ -> -// Libexecution.Lib.incorrectArgs ()) -// ; sqlSpec = NotYetImplementedTODO -// ; previewable = Impure -// ; deprecated = ReplacedBy(fn "" "" 0) } -// ; { name = fn "StaticAssets" "serveLatest" 1 -// ; parameters = [Param.make "file" TStr ""] -// ; returnType = TResult -// ; description = "Return the specified file from the latest deploy" -// ; fn = -// (function -// | state, [DStr file] -> -// let url = -// url_for -// state.canvas_id -// (latest_deploy_hash state.canvas_id) -// `Short -// (Unicode_string.to_string file) -// in -// let body, code, headers, _erroreturnType = -// Legacy.HttpclientV2.http_call_with_code -// ~raw_bytes:true -// url -// [] -// Httpclient.GET -// [] -// "" -// in -// let headers = -// headers -// |> List.map (fun (k, v) -> (k, String.trim v)) -// |> List.filter (fun (k, v) -> -// not -// (Core_kernel.String.is_substring -// k -// "Content-Length")) -// |> List.filter (fun (k, v) -> -// not -// (Core_kernel.String.is_substring -// k -// "Transfer-Encoding")) -// |> List.filter (fun (k, v) -> -// not -// (Core_kernel.String.is_substring -// k -// "Cache-Control")) -// |> List.filter (fun (k, v) -> not (String.trim k = "")) -// |> List.filter (fun (k, v) -> not (String.trim v = "")) -// in -// DResult -// (Ok -// (DResp -// ( Response (code, headers) -// , DBytes (body |> RawBytes.of_string) ))) -// | _ -> -// Libexecution.Lib.incorrectArgs ()) -// ; sqlSpec = NotYetImplementedTODO -// ; previewable = Impure -// ; deprecated = NotDeprecated } ] -// +let fns : List = + [ { name = fn "StaticAssets" "baseUrlFor" 0 + parameters = [ Param.make "deploy_hash" TStr "" ] + returnType = TStr + description = "Return the baseUrl for the specified deploy hash" + fn = + (function + | state, [ DStr deployHash ] -> + SA.url state.program.canvasName deployHash SA.Short |> DStr |> Ply + | _ -> incorrectArgs ()) + sqlSpec = NotYetImplementedTODO + previewable = Impure + deprecated = NotDeprecated } + + + { name = fn "StaticAssets" "baseUrlForLatest" 0 + parameters = [] + returnType = TStr + description = "Return the baseUrl for the latest deploy" + fn = + (function + | state, [] -> + uply { + let! deployHash = SA.latestDeployHash state.program.canvasID + let url = SA.url state.program.canvasName deployHash SA.Short + return DStr url + } + | _ -> incorrectArgs ()) + sqlSpec = NotYetImplementedTODO + previewable = Impure + deprecated = NotDeprecated } + + + { name = fn "StaticAssets" "urlFor" 0 + parameters = [ Param.make "deploy_hash" TStr ""; Param.make "file" TStr "" ] + returnType = TStr + description = "Return a url for the specified file and deploy hash" + fn = + (function + | state, [ DStr deployHash; DStr file ] -> + SA.urlFor state.program.canvasName deployHash SA.Short file |> DStr |> Ply + | _ -> incorrectArgs ()) + sqlSpec = NotYetImplementedTODO + previewable = Impure + deprecated = NotDeprecated } + + + { name = fn "StaticAssets" "urlForLatest" 0 + parameters = [ Param.make "file" TStr "" ] + returnType = TStr + description = "Return a url for the specified file and latest deploy" + fn = + (function + | state, [ DStr file ] -> + uply { + let! deployHash = SA.latestDeployHash state.program.canvasID + let url = SA.urlFor state.program.canvasName deployHash SA.Short file + return DStr url + } + | _ -> incorrectArgs ()) + sqlSpec = NotYetImplementedTODO + previewable = Impure + deprecated = NotDeprecated } + + + { name = fn "StaticAssets" "fetch" 0 + parameters = [ Param.make "deploy_hash" TStr ""; Param.make "file" TStr "" ] + returnType = TResult(TStr, TStr) + description = + "Return the specified file from the deploy_hash - only works on UTF8-safe files for now" + fn = + (function + | state, [ DStr deployHash; DStr file ] -> + uply { + let url = SA.urlFor state.program.canvasName deployHash SA.Short file + let! response = Legacy.HttpclientV0.call url Httpclient.GET [] "" + match response with + | Some dv -> return DResult(Ok dv) + | None -> return DResult(Error(DStr "Response was not UTF-8 safe")) + } + | _ -> incorrectArgs ()) + sqlSpec = NotYetImplementedTODO + previewable = Impure + deprecated = ReplacedBy(fn "" "" 0) } + + + { name = fn "StaticAssets" "fetch" 1 + parameters = [ Param.make "deploy_hash" TStr ""; Param.make "file" TStr "" ] + returnType = TResult(TStr, TStr) + description = + "Return the specified file from the deploy_hash - only works on UTF8-safe files for now" + fn = + (function + | state, [ DStr deployHash; DStr file ] -> + uply { + let url = SA.urlFor state.program.canvasName deployHash SA.Short file + let response = Legacy.HttpclientV0.call url Httpclient.GET [] "" + match response with + | Some dv -> return Dval.resultOk dv + | None -> return (DResult(Error(DStr "Response was not UTF-8 safe"))) + } + | _ -> incorrectArgs ()) + sqlSpec = NotYetImplementedTODO + previewable = Impure + deprecated = NotDeprecated } + + + { name = fn "StaticAssets" "fetchBytes" 0 + parameters = [ Param.make "deploy_hash" TStr ""; Param.make "file" TStr "" ] + returnType = TResult(TBytes, TStr) + description = "Return the bytes of the specified file from the deploy_hash" + fn = + (function + | state, [ DStr deployHash; DStr file ] -> + uply { + let url = SA.urlFor state.program.canvasName deployHash SA.Short file + let response = Legacy.HttpclientV1.call true url Httpclient.GET [] "" + return DResult(Ok(DBytes(response |> UTF8.toBytes))) + } + | _ -> incorrectArgs ()) + sqlSpec = NotYetImplementedTODO + previewable = Impure + deprecated = NotDeprecated } + + + { name = fn "StaticAssets" "fetchLatest" 0 + parameters = [ Param.make "file" TStr "" ] + returnType = TResult(TStr, TStr) + description = + "Return the specified file from the latest deploy - only works on UTF8-safe files for now" + fn = + (function + | state, [ DStr file ] -> + uply { + let! deployHash = SA.latestDeployHash state.program.canvasID + let url = SA.urlFor state.program.canvasName deployHash SA.Short file + let response = Legacy.HttpclientV0.call url Httpclient.GET [] "" + match response with + | Some dv -> return DResult(Ok dv) + | None -> return DResult(Error(DStr "Response was not UTF-8 safe")) + } + | _ -> incorrectArgs ()) + sqlSpec = NotYetImplementedTODO + previewable = Impure + deprecated = ReplacedBy(fn "StaticAssets" "fetchLatest" 1) } + + + { name = fn "StaticAssets" "fetchLatest" 1 + parameters = [ Param.make "file" TStr "" ] + returnType = TResult(TStr, TStr) + description = + "Return the specified file from the latest deploy - only works on UTF8-safe files for now" + fn = + (function + | state, [ DStr file ] -> + uply { + let! deployHash = SA.latestDeployHash state.program.canvasID + let url = SA.urlFor state.program.canvasName deployHash SA.Short file + let response = Legacy.HttpclientV0.call url Httpclient.GET [] "" + match response with + | Some dv -> return Dval.resultOk dv + | None -> return Dval.resultError (DStr "Response was not UTF-8 safe") + } + | _ -> incorrectArgs ()) + sqlSpec = NotYetImplementedTODO + previewable = Impure + deprecated = NotDeprecated } + + + { name = fn "StaticAssets" "fetchLatestBytes" 0 + parameters = [ Param.make "file" TStr "" ] + returnType = TResult(TBytes, TStr) + description = "Return the bytes of the specified file from the latest deploy" + fn = + (function + | state, [ DStr file ] -> + uply { + let! deployHash = SA.latestDeployHash state.program.canvasID + let url = SA.urlFor state.program.canvasName deployHash SA.Short file + let response = Legacy.HttpclientV1.call true url Httpclient.GET [] "" + return DResult(Ok(DBytes(response |> UTF8.toBytes))) + } + | _ -> incorrectArgs ()) + sqlSpec = NotYetImplementedTODO + previewable = Impure + deprecated = NotDeprecated } + + + { name = fn "StaticAssets" "serve" 0 + parameters = [ Param.make "deploy_hash" TStr ""; Param.make "file" TStr "" ] + returnType = TResult(THttpResponse TStr, TStr) + description = + "Return the specified file from the latest deploy - only works on UTF8-safe files for now" + fn = + (function + | state, [ DStr deployHash; DStr file ] -> + uply { + let url = SA.urlFor state.program.canvasName deployHash SA.Short file + let body, code, headers, _erroreturnType = + Legacy.HttpclientV2.http_call_with_code url [] Httpclient.GET [] "" + let headers = + headers + |> List.map (fun (k, v) -> (k, String.trim v)) + |> List.filter (fun (k, v) -> + not (String.is_substring k "Content-Length")) + |> List.filter (fun (k, v) -> + not (String.is_substring k "Transfer-Encoding")) + |> List.filter (fun (k, v) -> + not (String.is_substring k "Cache-Control")) + |> List.filter (fun (k, v) -> not (String.trim k = "")) + |> List.filter (fun (k, v) -> not (String.trim v = "")) + match body with + | Some dv -> + return DResult(Ok(DHttpResponse(Response(code, headers, dv)))) + | None -> return DResult(Error(DStr "Response was not UTF-8 safe")) + } + | _ -> incorrectArgs ()) + sqlSpec = NotYetImplementedTODO + previewable = Impure + deprecated = ReplacedBy(fn "StaticAssets" "serve" 1) } + + + { name = fn "StaticAssets" "serve" 1 + parameters = [ Param.make "deploy_hash" TStr ""; Param.make "file" TStr "" ] + returnType = TResult(THttpResponse TBytes, TStr) + description = "Return the specified file from the latest deploy" + fn = + (function + | state, [ DStr deployHash; DStr file ] -> + uply { + let url = SA.urlFor state.program.canvasName deployHash SA.Short file + let body, code, headers, _erroreturnType = + Legacy.HttpclientV2.http_call_with_code + true + url + [] + Httpclient.GET + [] + "" + let headers = + headers + |> List.map (fun (k, v) -> (k, String.trim v)) + |> List.filter (fun (k, v) -> + not (String.is_substring k "Content-Length")) + |> List.filter (fun (k, v) -> + not (String.is_substring k "Transfer-Encoding")) + |> List.filter (fun (k, v) -> + not (String.is_substring k "Cache-Control")) + |> List.filter (fun (k, v) -> not (String.trim k = "")) + |> List.filter (fun (k, v) -> not (String.trim v = "")) + return DResult(Ok(DHttpResponse(Response(code, headers, DBytes(body))))) + } + | _ -> incorrectArgs ()) + sqlSpec = NotYetImplementedTODO + previewable = Impure + deprecated = NotDeprecated } + + + { name = fn "StaticAssets" "serveLatest" 0 + parameters = [ Param.make "file" TStr "" ] + returnType = TResult(TStr, TStr) + description = + "Return the specified file from the latest deploy - only works on UTF8-safe files for now" + fn = + (function + | state, [ DStr file ] -> + uply { + let! deployHash = SA.latestDeployHash state.program.canvasID + let url = SA.urlFor state.program.canvasName deployHash SA.Short file + let body, code, headers, _erroreturnType = + Legacy.HttpclientV2.http_call_with_code + true + url + [] + Httpclient.GET + [] + "" + let headers = + headers + |> List.map (fun (k, v) -> (k, String.trim v)) + |> List.filter (fun (k, v) -> + not (String.is_substring k "Content-Length")) + |> List.filter (fun (k, v) -> + not (String.is_substring k "Transfer-Encoding")) + |> List.filter (fun (k, v) -> + not (String.is_substring k "Cache-Control")) + |> List.filter (fun (k, v) -> not (String.trim k = "")) + |> List.filter (fun (k, v) -> not (String.trim v = "")) + return DResult(Ok(DHttpResponse(Response(code, headers, DBytes body)))) + } + | _ -> incorrectArgs ()) + sqlSpec = NotYetImplementedTODO + previewable = Impure + deprecated = ReplacedBy(fn "" "" 0) } + + + { name = fn "StaticAssets" "serveLatest" 1 + parameters = [ Param.make "file" TStr "" ] + returnType = TResult + description = "Return the specified file from the latest deploy" + fn = + (function + | state, [ DStr file ] -> + uply { + let! deployHash = SA.latestDeployHash state.program.canvasID + let url = SA.urlFor state.program.canvasName deployHash SA.Short file + let body, code, headers, _erroreturnType = + Legacy.HttpclientV2.http_call_with_code + true + url + [] + Httpclient.GET + [] + "" + let headers = + headers + |> List.map (fun (k, v) -> (k, String.trim v)) + |> List.filter (fun (k, v) -> + not (String.is_substring k "Content-Length")) + |> List.filter (fun (k, v) -> + not (String.is_substring k "Transfer-Encoding")) + |> List.filter (fun (k, v) -> + not (String.is_substring k "Cache-Control")) + |> List.filter (fun (k, v) -> not (String.trim k = "")) + |> List.filter (fun (k, v) -> not (String.trim v = "")) + return DResult(Ok(DHttpResponse(Response(code, headers, DBytes(body))))) + } + | _ -> incorrectArgs ()) + sqlSpec = NotYetImplementedTODO + previewable = Impure + deprecated = NotDeprecated } ] diff --git a/fsharp-backend/src/LibBackend/StaticAssets.fs b/fsharp-backend/src/LibBackend/StaticAssets.fs index 2407384252..4b48b778d3 100644 --- a/fsharp-backend/src/LibBackend/StaticAssets.fs +++ b/fsharp-backend/src/LibBackend/StaticAssets.fs @@ -13,10 +13,6 @@ open Prelude open Prelude.Tablecloth open Tablecloth -// let pp_gcloud_err (err : Gcloud.Auth.error) : string = -// Gcloud.Auth.pp_error Format.str_formatter err ; -// Format.flush_str_formatter () - type DeployStatus = | Deploying | Deployed @@ -56,7 +52,7 @@ type StaticDeploy = // Lwt_result.fail (`GcloudAuthError (pp_gcloud_err x)) -let appHash (canvasName : CanvasName.T) (canvasID : CanvasID) : string = +let appHash (canvasName : CanvasName.T) : string = // enough of a hash to make this not easily discoverable $"{canvasName}SOME SALT HERE{LibService.Config.envDisplayName}" |> sha1digest @@ -69,41 +65,40 @@ type UrlType = | Short | Long -let url - (canvasName : CanvasName.T) - (canvasID : CanvasID) - (deployHash : string) - (t : UrlType) - : string = +let url (canvasName : CanvasName.T) (deployHash : string) (t : UrlType) : string = let domain = match t with | Short -> ".darksa.com" | Long -> ".darkstaticassets.com" - let apphash = appHash canvasName canvasID + let apphash = appHash canvasName + + $"https://{canvasName}{domain}/{apphash}/{deployHash}" + +// TODO [polish] could instrument this to error on bad deploy hash, maybe also +// unknown file +let urlFor + (canvasName : CanvasName.T) + (deployHash : string) + (variant : UrlType) + (file : string) + : string = + url canvasName deployHash variant + "/" + file + + +let latestDeployHash (canvasID : CanvasID) : Task = + let branch = "main" in + + Sql.query + "SELECT deploy_hash FROM static_asset_deploys + WHERE canvas_id=@canvasID AND branch=@branch AND live_at IS NOT NULL + ORDER BY created_at desc + LIMIT 1" + |> Sql.parameters [ "canvasID", Sql.uuid canvasID; "branch", Sql.string branch ] + |> Sql.executeRowAsync (fun read -> read.string "deploy_hash") + - $"https://{canvasName}{domain}/{apphash}/deployHash" -// (* TODO [polish] could instrument this to error on bad deploy hash, maybe also -// * unknown file *) -// let url_for (canvas_id : Uuidm.t) (deploy_hash : string) variant (file : string) -// : string = -// url canvas_id deploy_hash variant ^ "/" ^ file -// -// -// let latest_deploy_hash (canvas_id : Uuidm.t) : string = -// let branch = "main" in -// Db.fetch_one -// ~name:"select latest deploy hash" -// ~subject:(Uuidm.to_string canvas_id) -// "SELECT deploy_hash FROM static_asset_deploys -// WHERE canvas_id=$1 AND branch=$2 AND live_at IS NOT NULL -// ORDER BY created_at desc -// LIMIT 1" -// ~params:[Uuid canvas_id; String branch] -// |> List.hd_exn -// -// // let upload_to_bucket // (filename : string) // (body : string) From a9b725a5da47ccfea8bcc1145cc37835dbfc0b4f Mon Sep 17 00:00:00 2001 From: Paul Biggar Date: Thu, 24 Feb 2022 17:00:42 +0000 Subject: [PATCH 2/7] Complete --- .../src/BackendOnlyStdLib/LibStaticAssets.fs | 250 +++++++++++------- 1 file changed, 152 insertions(+), 98 deletions(-) diff --git a/fsharp-backend/src/BackendOnlyStdLib/LibStaticAssets.fs b/fsharp-backend/src/BackendOnlyStdLib/LibStaticAssets.fs index e6185fecd1..d4ccb862a5 100644 --- a/fsharp-backend/src/BackendOnlyStdLib/LibStaticAssets.fs +++ b/fsharp-backend/src/BackendOnlyStdLib/LibStaticAssets.fs @@ -14,8 +14,95 @@ let err (str : string) = Ply(Dval.errStr str) let incorrectArgs = LibExecution.Errors.incorrectArgs -let varA = TVariable "a" -let varB = TVariable "b" +open System.IO +open System.IO.Compression +open System.Net.Http + +let httpClient = + let socketHandler : HttpMessageHandler = + let handler = new SocketsHttpHandler() + + // Cookies shouldn't be necessary + handler.UseCookies <- false + handler + + let client = new HttpClient(socketHandler, disposeHandler = false) + client.Timeout <- System.TimeSpan.FromSeconds 30.0 + // Can't find what this was in OCaml/Curl, but 100MB seems a reasonable default + client.MaxResponseContentBufferSize <- 1024L * 1024L * 100L + client + + + + +/// Replaces legacy HttpClientv0. Returns bytes, and throws on non-200s or if +/// anything goes wrong. +let getV0 (url : string) : Task = + task { + try + use req = new HttpRequestMessage(HttpMethod.Get, url) + let! response = httpClient.SendAsync req + let code = int response.StatusCode + let! body = response.Content.ReadAsByteArrayAsync() + if code < 200 || code >= 300 then + return + Exception.raiseLibrary + $"Bad HTTP response ({code}) in call to {url}" + [ "url", url; "code", code; "body", UTF8.ofBytesWithReplacement body ] + else + return body + with + | e -> + return + Exception.raiseLibrary + $"Internal HTTP-stack exception: {e.Message}" + [ "url", url ] + } + +/// Replaces legacy HttpClientv1. Returns bytes, headers, and status code, and throws +/// on non-200s or if anything goes wrong. +let getV1 (url : string) : Task * int> = + task { + try + use req = new HttpRequestMessage(HttpMethod.Get, url) + let! response = httpClient.SendAsync req + let code = int response.StatusCode + let headers = response.Headers |> HttpClient.convertHeaders + let! body = response.Content.ReadAsByteArrayAsync() + if code < 200 || code >= 300 then + return + Exception.raiseLibrary + $"Bad HTTP response ({code}) in call to {url}" + [ "url", url; "code", code; "body", UTF8.ofBytesWithReplacement body ] + else + return body, headers, code + with + | e -> + return + Exception.raiseLibrary + $"Internal HTTP-stack exception: {e.Message}" + [ "url", url ] + } + +/// Replaces legacy HttpClientv2. Returns bytes, headers, and status code, and throws +/// if the request has issues. Does not raise on non-200 status code. +let getV2 (url : string) : Task * int> = + task { + try + use req = new HttpRequestMessage(HttpMethod.Get, url) + let! response = httpClient.SendAsync req + let code = int response.StatusCode + let headers = response.Headers |> HttpClient.convertHeaders + let! body = response.Content.ReadAsByteArrayAsync() + return body, headers, code + with + | e -> + return + Exception.raiseLibrary + $"Internal HTTP-stack exception: {e.Message}" + [ "url", url ] + } + let fns : List = [ { name = fn "StaticAssets" "baseUrlFor" 0 @@ -27,7 +114,7 @@ let fns : List = | state, [ DStr deployHash ] -> SA.url state.program.canvasName deployHash SA.Short |> DStr |> Ply | _ -> incorrectArgs ()) - sqlSpec = NotYetImplementedTODO + sqlSpec = NotQueryable previewable = Impure deprecated = NotDeprecated } @@ -45,7 +132,7 @@ let fns : List = return DStr url } | _ -> incorrectArgs ()) - sqlSpec = NotYetImplementedTODO + sqlSpec = NotQueryable previewable = Impure deprecated = NotDeprecated } @@ -59,7 +146,7 @@ let fns : List = | state, [ DStr deployHash; DStr file ] -> SA.urlFor state.program.canvasName deployHash SA.Short file |> DStr |> Ply | _ -> incorrectArgs ()) - sqlSpec = NotYetImplementedTODO + sqlSpec = NotQueryable previewable = Impure deprecated = NotDeprecated } @@ -77,7 +164,7 @@ let fns : List = return DStr url } | _ -> incorrectArgs ()) - sqlSpec = NotYetImplementedTODO + sqlSpec = NotQueryable previewable = Impure deprecated = NotDeprecated } @@ -92,13 +179,14 @@ let fns : List = | state, [ DStr deployHash; DStr file ] -> uply { let url = SA.urlFor state.program.canvasName deployHash SA.Short file - let! response = Legacy.HttpclientV0.call url Httpclient.GET [] "" - match response with - | Some dv -> return DResult(Ok dv) + + let! response = getV0 url + match UTF8.ofBytesOpt response with + | Some dv -> return DResult(Ok(DStr dv)) | None -> return DResult(Error(DStr "Response was not UTF-8 safe")) } | _ -> incorrectArgs ()) - sqlSpec = NotYetImplementedTODO + sqlSpec = NotQueryable previewable = Impure deprecated = ReplacedBy(fn "" "" 0) } @@ -113,13 +201,13 @@ let fns : List = | state, [ DStr deployHash; DStr file ] -> uply { let url = SA.urlFor state.program.canvasName deployHash SA.Short file - let response = Legacy.HttpclientV0.call url Httpclient.GET [] "" - match response with - | Some dv -> return Dval.resultOk dv + let! response = getV0 url + match UTF8.ofBytesOpt response with + | Some dv -> return DResult(Ok(DStr dv)) | None -> return (DResult(Error(DStr "Response was not UTF-8 safe"))) } | _ -> incorrectArgs ()) - sqlSpec = NotYetImplementedTODO + sqlSpec = NotQueryable previewable = Impure deprecated = NotDeprecated } @@ -133,11 +221,11 @@ let fns : List = | state, [ DStr deployHash; DStr file ] -> uply { let url = SA.urlFor state.program.canvasName deployHash SA.Short file - let response = Legacy.HttpclientV1.call true url Httpclient.GET [] "" - return DResult(Ok(DBytes(response |> UTF8.toBytes))) + let! response, _, _ = getV1 url + return DResult(Ok(DBytes response)) } | _ -> incorrectArgs ()) - sqlSpec = NotYetImplementedTODO + sqlSpec = NotQueryable previewable = Impure deprecated = NotDeprecated } @@ -153,13 +241,13 @@ let fns : List = uply { let! deployHash = SA.latestDeployHash state.program.canvasID let url = SA.urlFor state.program.canvasName deployHash SA.Short file - let response = Legacy.HttpclientV0.call url Httpclient.GET [] "" - match response with - | Some dv -> return DResult(Ok dv) + let! response = getV0 url + match UTF8.ofBytesOpt response with + | Some str -> return DResult(Ok(DStr str)) | None -> return DResult(Error(DStr "Response was not UTF-8 safe")) } | _ -> incorrectArgs ()) - sqlSpec = NotYetImplementedTODO + sqlSpec = NotQueryable previewable = Impure deprecated = ReplacedBy(fn "StaticAssets" "fetchLatest" 1) } @@ -175,13 +263,13 @@ let fns : List = uply { let! deployHash = SA.latestDeployHash state.program.canvasID let url = SA.urlFor state.program.canvasName deployHash SA.Short file - let response = Legacy.HttpclientV0.call url Httpclient.GET [] "" - match response with - | Some dv -> return Dval.resultOk dv + let! response = getV0 url + match UTF8.ofBytesOpt response with + | Some str -> return Dval.resultOk (DStr str) | None -> return Dval.resultError (DStr "Response was not UTF-8 safe") } | _ -> incorrectArgs ()) - sqlSpec = NotYetImplementedTODO + sqlSpec = NotQueryable previewable = Impure deprecated = NotDeprecated } @@ -196,11 +284,11 @@ let fns : List = uply { let! deployHash = SA.latestDeployHash state.program.canvasID let url = SA.urlFor state.program.canvasName deployHash SA.Short file - let response = Legacy.HttpclientV1.call true url Httpclient.GET [] "" - return DResult(Ok(DBytes(response |> UTF8.toBytes))) + let! response, _, _ = getV1 url + return DResult(Ok(DBytes(response))) } | _ -> incorrectArgs ()) - sqlSpec = NotYetImplementedTODO + sqlSpec = NotQueryable previewable = Impure deprecated = NotDeprecated } @@ -215,26 +303,22 @@ let fns : List = | state, [ DStr deployHash; DStr file ] -> uply { let url = SA.urlFor state.program.canvasName deployHash SA.Short file - let body, code, headers, _erroreturnType = - Legacy.HttpclientV2.http_call_with_code url [] Httpclient.GET [] "" + let! (body, headers, code) = getV2 url let headers = headers - |> List.map (fun (k, v) -> (k, String.trim v)) - |> List.filter (fun (k, v) -> - not (String.is_substring k "Content-Length")) - |> List.filter (fun (k, v) -> - not (String.is_substring k "Transfer-Encoding")) - |> List.filter (fun (k, v) -> - not (String.is_substring k "Cache-Control")) - |> List.filter (fun (k, v) -> not (String.trim k = "")) - |> List.filter (fun (k, v) -> not (String.trim v = "")) - match body with - | Some dv -> - return DResult(Ok(DHttpResponse(Response(code, headers, dv)))) + |> List.map (fun (k, v) -> (k, v.Trim())) + |> List.filter (fun (k, v) -> not (k.Contains("Content-Length"))) + |> List.filter (fun (k, v) -> not (k.Contains("Transfer-Encoding"))) + |> List.filter (fun (k, v) -> not (k.Contains("Cache-Control"))) + |> List.filter (fun (k, v) -> not (k.Trim() = "")) + |> List.filter (fun (k, v) -> not (v.Trim() = "")) + match UTF8.ofBytesOpt body with + | Some str -> + return DResult(Ok(DHttpResponse(Response(code, headers, DStr str)))) | None -> return DResult(Error(DStr "Response was not UTF-8 safe")) } | _ -> incorrectArgs ()) - sqlSpec = NotYetImplementedTODO + sqlSpec = NotQueryable previewable = Impure deprecated = ReplacedBy(fn "StaticAssets" "serve" 1) } @@ -248,29 +332,19 @@ let fns : List = | state, [ DStr deployHash; DStr file ] -> uply { let url = SA.urlFor state.program.canvasName deployHash SA.Short file - let body, code, headers, _erroreturnType = - Legacy.HttpclientV2.http_call_with_code - true - url - [] - Httpclient.GET - [] - "" + let! (body, headers, code) = getV2 url let headers = headers - |> List.map (fun (k, v) -> (k, String.trim v)) - |> List.filter (fun (k, v) -> - not (String.is_substring k "Content-Length")) - |> List.filter (fun (k, v) -> - not (String.is_substring k "Transfer-Encoding")) - |> List.filter (fun (k, v) -> - not (String.is_substring k "Cache-Control")) - |> List.filter (fun (k, v) -> not (String.trim k = "")) - |> List.filter (fun (k, v) -> not (String.trim v = "")) + |> List.map (fun (k, v) -> (k, v.Trim())) + |> List.filter (fun (k, v) -> not (k.Contains "Content-Length")) + |> List.filter (fun (k, v) -> not (k.Contains "Transfer-Encoding")) + |> List.filter (fun (k, v) -> not (k.Contains "Cache-Control")) + |> List.filter (fun (k, v) -> not (k.Trim() = "")) + |> List.filter (fun (k, v) -> not (v.Trim() = "")) return DResult(Ok(DHttpResponse(Response(code, headers, DBytes(body))))) } | _ -> incorrectArgs ()) - sqlSpec = NotYetImplementedTODO + sqlSpec = NotQueryable previewable = Impure deprecated = NotDeprecated } @@ -286,36 +360,26 @@ let fns : List = uply { let! deployHash = SA.latestDeployHash state.program.canvasID let url = SA.urlFor state.program.canvasName deployHash SA.Short file - let body, code, headers, _erroreturnType = - Legacy.HttpclientV2.http_call_with_code - true - url - [] - Httpclient.GET - [] - "" + let! body, headers, code = getV2 url let headers = headers - |> List.map (fun (k, v) -> (k, String.trim v)) - |> List.filter (fun (k, v) -> - not (String.is_substring k "Content-Length")) - |> List.filter (fun (k, v) -> - not (String.is_substring k "Transfer-Encoding")) - |> List.filter (fun (k, v) -> - not (String.is_substring k "Cache-Control")) - |> List.filter (fun (k, v) -> not (String.trim k = "")) - |> List.filter (fun (k, v) -> not (String.trim v = "")) + |> List.map (fun (k, v) -> (k, v.Trim())) + |> List.filter (fun (k, v) -> not (k.Contains "Content-Length")) + |> List.filter (fun (k, v) -> not (k.Contains "Transfer-Encoding")) + |> List.filter (fun (k, v) -> not (k.Contains "Cache-Control")) + |> List.filter (fun (k, v) -> not (k.Trim() = "")) + |> List.filter (fun (k, v) -> not (v.Trim() = "")) return DResult(Ok(DHttpResponse(Response(code, headers, DBytes body)))) } | _ -> incorrectArgs ()) - sqlSpec = NotYetImplementedTODO + sqlSpec = NotQueryable previewable = Impure deprecated = ReplacedBy(fn "" "" 0) } { name = fn "StaticAssets" "serveLatest" 1 parameters = [ Param.make "file" TStr "" ] - returnType = TResult + returnType = TResult(THttpResponse(TBytes), TStr) description = "Return the specified file from the latest deploy" fn = (function @@ -323,28 +387,18 @@ let fns : List = uply { let! deployHash = SA.latestDeployHash state.program.canvasID let url = SA.urlFor state.program.canvasName deployHash SA.Short file - let body, code, headers, _erroreturnType = - Legacy.HttpclientV2.http_call_with_code - true - url - [] - Httpclient.GET - [] - "" + let! body, headers, code = getV2 url let headers = headers - |> List.map (fun (k, v) -> (k, String.trim v)) - |> List.filter (fun (k, v) -> - not (String.is_substring k "Content-Length")) - |> List.filter (fun (k, v) -> - not (String.is_substring k "Transfer-Encoding")) - |> List.filter (fun (k, v) -> - not (String.is_substring k "Cache-Control")) - |> List.filter (fun (k, v) -> not (String.trim k = "")) - |> List.filter (fun (k, v) -> not (String.trim v = "")) + |> List.map (fun (k, v) -> (k, v.Trim())) + |> List.filter (fun (k, v) -> not (k.Contains "Content-Length")) + |> List.filter (fun (k, v) -> not (k.Contains "Transfer-Encoding")) + |> List.filter (fun (k, v) -> not (k.Contains "Cache-Control")) + |> List.filter (fun (k, v) -> not (k.Trim() = "")) + |> List.filter (fun (k, v) -> not (v.Trim() = "")) return DResult(Ok(DHttpResponse(Response(code, headers, DBytes(body))))) } | _ -> incorrectArgs ()) - sqlSpec = NotYetImplementedTODO + sqlSpec = NotQueryable previewable = Impure deprecated = NotDeprecated } ] From 770a38ec3ecefbcd0ce1551d7264405f8a9f0216 Mon Sep 17 00:00:00 2001 From: Paul Biggar Date: Thu, 24 Feb 2022 17:26:22 +0000 Subject: [PATCH 3/7] Fix final error --- fsharp-backend/src/LibBackend/StaticAssets.fs | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/fsharp-backend/src/LibBackend/StaticAssets.fs b/fsharp-backend/src/LibBackend/StaticAssets.fs index 4b48b778d3..140a13d3a8 100644 --- a/fsharp-backend/src/LibBackend/StaticAssets.fs +++ b/fsharp-backend/src/LibBackend/StaticAssets.fs @@ -253,15 +253,18 @@ let latestDeployHash (canvasID : CanvasID) : Task = // ; url = url canvas_id deploy_hash `Short // ; last_update // ; status = Deployed } -// + let allDeploysInCanvas (canvasName : CanvasName.T) (canvasID : CanvasID) : Task> = Sql.query - "SELECT deploy_hash, created_at, live_at FROM static_asset_deploys - WHERE canvas_id=@canvasID ORDER BY created_at DESC LIMIT 25" + "SELECT deploy_hash, created_at, live_at + FROM static_asset_deploys + WHERE canvas_id=@canvasID + ORDER BY created_at + DESC LIMIT 25" |> Sql.parameters [ "canvasID", Sql.uuid canvasID ] |> Sql.executeAsync (fun read -> let deployHash = read.string "deploy_hash" @@ -272,6 +275,6 @@ let allDeploysInCanvas | None -> Deploying, read.instant "created_at" { deployHash = deployHash - url = url canvasName canvasID deployHash Short + url = url canvasName deployHash Short status = status lastUpdate = lastUpdate }) From b86de1f6cb5e27fabcad87d5510d5aa5702c5f42 Mon Sep 17 00:00:00 2001 From: Paul Biggar Date: Thu, 24 Feb 2022 20:03:14 +0000 Subject: [PATCH 4/7] Fix initialization errors --- fsharp-backend/src/BackendOnlyStdLib/LibStaticAssets.fs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/fsharp-backend/src/BackendOnlyStdLib/LibStaticAssets.fs b/fsharp-backend/src/BackendOnlyStdLib/LibStaticAssets.fs index d4ccb862a5..1afa27f96f 100644 --- a/fsharp-backend/src/BackendOnlyStdLib/LibStaticAssets.fs +++ b/fsharp-backend/src/BackendOnlyStdLib/LibStaticAssets.fs @@ -188,7 +188,7 @@ let fns : List = | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure - deprecated = ReplacedBy(fn "" "" 0) } + deprecated = ReplacedBy(fn "StaticAssets" "fetch" 1) } { name = fn "StaticAssets" "fetch" 1 @@ -374,7 +374,7 @@ let fns : List = | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure - deprecated = ReplacedBy(fn "" "" 0) } + deprecated = ReplacedBy(fn "StaticAssets" "serveLatest" 1) } { name = fn "StaticAssets" "serveLatest" 1 From 62b46801f40d75a36617ea4e179a50f061adc3b0 Mon Sep 17 00:00:00 2001 From: Paul Biggar Date: Thu, 24 Feb 2022 20:27:17 +0000 Subject: [PATCH 5/7] Implement libtwilio --- .../src/BackendOnlyStdLib/LibTwilio.fs | 223 ++++++++---------- fsharp-backend/src/LibBackend/Canvas.fs | 5 +- 2 files changed, 103 insertions(+), 125 deletions(-) diff --git a/fsharp-backend/src/BackendOnlyStdLib/LibTwilio.fs b/fsharp-backend/src/BackendOnlyStdLib/LibTwilio.fs index 19def901f3..5707750cc3 100644 --- a/fsharp-backend/src/BackendOnlyStdLib/LibTwilio.fs +++ b/fsharp-backend/src/BackendOnlyStdLib/LibTwilio.fs @@ -6,6 +6,8 @@ open Prelude module Errors = LibExecution.Errors +module Canvas = LibBackend.Canvas + let fn = FQFnName.stdlibFnName let err (str : string) = Ply(Dval.errStr str) @@ -15,125 +17,102 @@ let incorrectArgs = LibExecution.Errors.incorrectArgs let varA = TVariable "a" let varB = TVariable "b" -let fns : List = [] -// [ { name = fn "Twilio" "sendText" 0 -// -// ; parameters = -// [ Param.make "accountSID" TStr -// ; Param.make "authToken" TStr -// ; Param.make "fromNumber" TStr -// ; Param.make "toNumber" TStr -// ; Param.make "body" TStr ] -// ; returnType = TObj -// ; description = -// "Send text with `body` to phone number `toNumber` from number `fromNumber`, authenticated via `accountSID` and `authToken`" -// ; fn = -// (function -// | ( s -// , [ DStr accountSID -// ; DStr authToken -// ; DStr fromNumber -// ; DStr toNumber -// ; DStr body ] ) -> -// let basic_auth_string = -// Libhttpclient.encode_basic_auth_broken accountSID authToken -// in -// let encoding = "application/x-www-form-urlencoded" in -// let headers = -// [ ("Authorization", DStr basic_auth_string) -// ; ("Content-Type", Libexecution.DStr encoding) -// ] -// |> DvalMap.from_list -// |> DObj -// in -// let host_url = Canvas.url_for s.canvas_id in -// let body = -// [ ("From", DStr fromNumber) -// ; ("To", DStr toNumber) -// ; ("Body", DStr body) -// ; ("ValidityPeriod", Libexecution.DStr "900") -// ; ( "StatusCallback" -// , Libexecution.DStr -// (host_url ^ "/twilioCallback") ) ] -// |> DvalMap.fromList -// |> DObj -// in -// let twilio_uri = -// "https://api.twilio.com/2010-04-01/Accounts/" -// ^ Libexecution.Unicode_string.to_string accountSID -// ^ "/Messages.json" -// in -// Legacy.LibhttpclientV2.send_request -// twilio_uri -// Httpclient.POST -// Libexecution.Dval.to_pretty_machine_json_v1 -// body -// (DObj DvalMap.empty) -// headers -// | _ -> -// incorrectArgs ()) -// ; sqlSpec = NotQueryable -// ; previewable = Impure -// ; deprecated = -// true -// (* Deprecated due to using Libhttpclient.encode_basic_auth_broken *) } -// -// ; { name = fn "Twilio" "sendText" 1 -// ; parameters = -// [ Param.make "accountSID" TStr -// ; Param.make "authToken" TStr -// ; Param.make "fromNumber" TStr -// ; Param.make "toNumber" TStr -// ; Param.make "body" TStr ] -// ; returnType = TObj -// ; description = -// "Send text with `body` to phone number `toNumber` from number `fromNumber`, authenticated via `accountSID` and `authToken`" -// ; fn = -// (function -// | ( s -// , [ DStr accountSID -// ; DStr authToken -// ; DStr fromNumber -// ; DStr toNumber -// ; DStr body ] ) -> -// let basic_auth_string = -// Libhttpclient.encode_basic_auth accountSID authToken -// in -// let encoding = "application/x-www-form-urlencoded" in -// let headers = -// [ ("Authorization", DStr basic_auth_string) -// ; ("Content-Type", Libexecution.DStr encoding) -// ] -// |> DvalMap.from_list -// |> DObj -// in -// let host_url = Canvas.url_for s.canvas_id in -// let body = -// [ ("From", DStr fromNumber) -// ; ("To", DStr toNumber) -// ; ("Body", DStr body) -// ; ("ValidityPeriod", Libexecution.DStr "900") -// ; ( "StatusCallback" -// , Libexecution.DStr -// (host_url ^ "/twilioCallback") ) ] -// |> DvalMap.fromList -// |> DObj -// in -// let twilio_uri = -// "https://api.twilio.com/2010-04-01/Accounts/" -// ^ Libexecution.Unicode_string.to_string accountSID -// ^ "/Messages.json" -// in -// Legacy.LibhttpclientV2.send_request -// twilio_uri -// Httpclient.POST -// Libexecution.Dval.to_pretty_machine_json_v1 -// body -// (DObj DvalMap.empty) -// headers -// | _ -> -// incorrectArgs ()) -// ; sqlSpec = NotQueryable -// ; previewable = Impure -// ; deprecated = NotDeprecated } ] -// +let fns : List = + [ { name = fn "Twilio" "sendText" 0 + + parameters = + [ Param.make "accountSID" TStr "" + Param.make "authToken" TStr "" + Param.make "fromNumber" TStr "" + Param.make "toNumber" TStr "" + Param.make "body" TStr "" ] + returnType = TDict(varA) + description = + "Send text with `body` to phone number `toNumber` from number `fromNumber`, authenticated via `accountSID` and `authToken`" + fn = + (function + | (s, + [ DStr accountSID + DStr authToken + DStr fromNumber + DStr toNumber + DStr body ]) -> + let basicAuthString = + LibHttpClientAuth.encodeBasicAuthBroken accountSID authToken + let encoding = "application/x-www-form-urlencoded" in + let headers = + [ ("Authorization", DStr basicAuthString) + ("Content-Type", DStr encoding) ] + |> Map + |> DObj + let hostUrl = Canvas.urlFor s.program.canvasName in + let body = + [ ("From", DStr fromNumber) + ("To", DStr toNumber) + ("Body", DStr body) + ("ValidityPeriod", DStr "900") + ("StatusCallback", DStr(hostUrl + "/twilioCallback")) ] + |> Map + |> DObj + let twilioUri = + $"https://api.twilio.com/2010-04-01/Accounts/{accountSID}/Messages.json" + LegacyHttpClient0.sendRequest + twilioUri + System.Net.Http.HttpMethod.Post + LibExecution.DvalReprExternal.toPrettyMachineJsonStringV1 + (Some body) + (DObj Map.empty) + headers + | _ -> incorrectArgs ()) + sqlSpec = NotYetImplementedTODO + previewable = Impure + // Deprecated due to using encodeBasicAuthBroken + deprecated = DeprecatedBecause "bad unicode support" } + { name = fn "Twilio" "sendText" 1 + parameters = + [ Param.make "accountSID" TStr "" + Param.make "authToken" TStr "" + Param.make "fromNumber" TStr "" + Param.make "toNumber" TStr "" + Param.make "body" TStr "" ] + returnType = varA + description = + "Send text with `body` to phone number `toNumber` from number `fromNumber`, authenticated via `accountSID` and `authToken`" + fn = + (function + | (s, + [ DStr accountSID + DStr authToken + DStr fromNumber + DStr toNumber + DStr body ]) -> + let basicAuthString = + LibHttpClientAuth.encodeBasicAuth accountSID authToken + let encoding = "application/x-www-form-urlencoded" in + let headers = + [ ("Authorization", DStr basicAuthString) + ("Content-Type", DStr encoding) ] + |> Map + |> DObj + let hostUrl = Canvas.urlFor s.program.canvasName in + let body = + [ ("From", DStr fromNumber) + ("To", DStr toNumber) + ("Body", DStr body) + ("ValidityPeriod", DStr "900") + ("StatusCallback", DStr(hostUrl + "/twilioCallback")) ] + |> Map + |> DObj + let twilioUri = + $"https://api.twilio.com/2010-04-01/Accounts/{accountSID}/Messages.json" + LegacyHttpClient0.sendRequest + twilioUri + System.Net.Http.HttpMethod.Post + LibExecution.DvalReprExternal.toPrettyMachineJsonStringV1 + (Some body) + (DObj Map.empty) + headers + | _ -> incorrectArgs ()) + sqlSpec = NotYetImplementedTODO + previewable = Impure + deprecated = NotDeprecated } ] diff --git a/fsharp-backend/src/LibBackend/Canvas.fs b/fsharp-backend/src/LibBackend/Canvas.fs index 595385b5b8..9f95ef9a32 100644 --- a/fsharp-backend/src/LibBackend/Canvas.fs +++ b/fsharp-backend/src/LibBackend/Canvas.fs @@ -334,9 +334,8 @@ let updateCorsSetting |> Sql.executeStatementAsync -// let url_for (id : Uuidm.t) : string = -// let canvas_name = name_for_id id in -// "http://" ^ canvas_name ^ "." ^ Config.public_domain +let urlFor (canvasName : CanvasName.T) : string = + $"https://{canvasName}.{Config.publicDomain}" // ------------------------- From c485c09b756e0ae8291fa438dcc86ab291e5bdec Mon Sep 17 00:00:00 2001 From: Paul Biggar Date: Thu, 24 Feb 2022 20:43:49 +0000 Subject: [PATCH 6/7] Fix errors --- .../src/BackendOnlyStdLib/LibStaticAssets.fs | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/fsharp-backend/src/BackendOnlyStdLib/LibStaticAssets.fs b/fsharp-backend/src/BackendOnlyStdLib/LibStaticAssets.fs index 1afa27f96f..75b2bfb637 100644 --- a/fsharp-backend/src/BackendOnlyStdLib/LibStaticAssets.fs +++ b/fsharp-backend/src/BackendOnlyStdLib/LibStaticAssets.fs @@ -1,9 +1,11 @@ /// StdLib functions to manage and retrieve static assets of Dark users module BackendOnlyStdLib.LibStaticAssets +open System.Threading.Tasks +open FSharp.Control.Tasks + open LibExecution.RuntimeTypes open Prelude -open LibExecution.RuntimeTypes module SA = LibBackend.StaticAssets module Errors = LibExecution.Errors @@ -12,7 +14,7 @@ let fn = FQFnName.stdlibFnName let err (str : string) = Ply(Dval.errStr str) -let incorrectArgs = LibExecution.Errors.incorrectArgs +let incorrectArgs = Errors.incorrectArgs open System.IO open System.IO.Compression @@ -67,7 +69,7 @@ let getV1 (url : string) : Task * int> = use req = new HttpRequestMessage(HttpMethod.Get, url) let! response = httpClient.SendAsync req let code = int response.StatusCode - let headers = response.Headers |> HttpClient.convertHeaders + let headers = response.Headers |> HttpHeaders.fromAspNetHeaders let! body = response.Content.ReadAsByteArrayAsync() if code < 200 || code >= 300 then return @@ -92,7 +94,7 @@ let getV2 (url : string) : Task * int> = use req = new HttpRequestMessage(HttpMethod.Get, url) let! response = httpClient.SendAsync req let code = int response.StatusCode - let headers = response.Headers |> HttpClient.convertHeaders + let headers = response.Headers |> HttpHeaders.fromAspNetHeaders let! body = response.Content.ReadAsByteArrayAsync() return body, headers, code with From 6578f4ab062c546c8388c242d909eefc8d7122d1 Mon Sep 17 00:00:00 2001 From: Paul Biggar Date: Thu, 24 Feb 2022 23:31:37 +0000 Subject: [PATCH 7/7] Review changes --- fsharp-backend/src/BackendOnlyStdLib/LibTwilio.fs | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/fsharp-backend/src/BackendOnlyStdLib/LibTwilio.fs b/fsharp-backend/src/BackendOnlyStdLib/LibTwilio.fs index 5707750cc3..ce32696b4c 100644 --- a/fsharp-backend/src/BackendOnlyStdLib/LibTwilio.fs +++ b/fsharp-backend/src/BackendOnlyStdLib/LibTwilio.fs @@ -10,12 +10,9 @@ module Canvas = LibBackend.Canvas let fn = FQFnName.stdlibFnName -let err (str : string) = Ply(Dval.errStr str) - -let incorrectArgs = LibExecution.Errors.incorrectArgs +let incorrectArgs = Errors.incorrectArgs let varA = TVariable "a" -let varB = TVariable "b" let fns : List = [ { name = fn "Twilio" "sendText" 0 @@ -64,7 +61,7 @@ let fns : List = (DObj Map.empty) headers | _ -> incorrectArgs ()) - sqlSpec = NotYetImplementedTODO + sqlSpec = NotQueryable previewable = Impure // Deprecated due to using encodeBasicAuthBroken deprecated = DeprecatedBecause "bad unicode support" } @@ -113,6 +110,6 @@ let fns : List = (DObj Map.empty) headers | _ -> incorrectArgs ()) - sqlSpec = NotYetImplementedTODO + sqlSpec = NotQueryable previewable = Impure deprecated = NotDeprecated } ]