Use undici to perform HTTP requests with file-system cache.

generator/src/build.js

@@ -8,6 +8,7 @@ const globby = require("globby");
 const preRenderHtml = require("./pre-render-html.js");
 const { StaticPool } = require("node-worker-threads-pool");
 const os = require("os");
+const { ensureDirSync } = require("./file-helpers.js");
 
 const DIR_PATH = path.join(process.cwd());
 const OUTPUT_FILE_NAME = "elm.js";
@@ -25,7 +26,8 @@ const ELM_FILE_PATH = path.join(
 );
 
 async function ensureRequiredDirs() {
-  await fs.tryMkdir(`dist`);
+  ensureDirSync(`dist`);
+  ensureDirSync(path.join(process.cwd(), ".elm-pages", "http-response-cache"));
 }
 
 async function run(options) {

generator/src/dev-server.js

@@ -11,9 +11,11 @@ const connect = require("connect");
 const { restoreColor } = require("./error-formatter");
 const { StaticPool } = require("node-worker-threads-pool");
 const os = require("os");
+const { ensureDirSync } = require("./file-helpers.js");
 let Elm;
 
 async function start(options) {
+  ensureDirSync(path.join(process.cwd(), ".elm-pages", "http-response-cache"));
   const cpuCount = os.cpus().length;
   const pool = new StaticPool({
     size: Math.max(1, cpuCount / 2 - 1),

generator/src/render-worker.js

@@ -8,7 +8,6 @@ const { parentPort, threadId } = require("worker_threads");
 global.staticHttpCache = {};
 
 async function run({ mode, pathname }) {
-  console.log("Run", { mode, pathname });
   console.time(`${threadId} ${pathname}`);
   const req = null;
   const renderResult = await renderer(

generator/src/render.js

@@ -5,6 +5,7 @@ const matter = require("gray-matter");
 const globby = require("globby");
 const fsPromises = require("fs").promises;
 const preRenderHtml = require("./pre-render-html.js");
+const { lookupOrPerform } = require("./request-cache.js");
 
 let foundErrors = false;
 process.on("unhandledRejection", (error) => {
@@ -62,8 +63,7 @@ function runElmApp(elmModule, pagePath, request, addDataSourceWatcher) {
     });
 
     killApp = () => {
-      // app.ports.toJsPort.unsubscribe(portHandler);
+      app.ports.toJsPort.unsubscribe(portHandler);
-      // TODO restore die() code after getting worker threads build working
       app.die();
       app = null;
       // delete require.cache[require.resolve(compiledElmPath)];
@@ -128,6 +128,22 @@ function runElmApp(elmModule, pagePath, request, addDataSourceWatcher) {
             data: { filePath },
           });
         }
+      } else if (fromElm.tag === "DoHttp") {
+        const requestToPerform = fromElm.args[0];
+
+        const responseFilePath = await lookupOrPerform(
+          requestToPerform.unmasked
+        );
+
+        app.ports.fromJsPort.send({
+          tag: "GotHttp",
+          data: {
+            request: requestToPerform,
+            result: (
+              await fsPromises.readFile(responseFilePath, "utf8")
+            ).toString(),
+          },
+        });
       } else if (fromElm.tag === "Glob") {
         const globPattern = fromElm.args[0];
         addDataSourceWatcher(globPattern);

generator/src/request-cache.js

@@ -0,0 +1,116 @@
+const path = require("path");
+const undici = require("undici");
+const fs = require("fs");
+const objectHash = require("object-hash");
+
+/**
+ * To cache HTTP requests on disk with quick lookup and insertion, we store the hashed request.
+ * This uses SHA1 hashes. They are uni-directional hashes, which works for this use case. Most importantly,
+ * they're unique enough and can be expressed in a case-insensitive way so it works on Windows filesystems.
+ * And they are 40 hex characters, so the length won't be too long no matter what the request payload.
+ * @param {Object} request
+ */
+function requestToString(request) {
+  return objectHash(request);
+}
+/**
+ * @param {Object} request
+ */
+function fullPath(request) {
+  return path.join(
+    process.cwd(),
+    ".elm-pages",
+    "http-response-cache",
+    requestToString(request)
+  );
+}
+
+/**
+ * @param {{url: string; headers: {[x: string]: string}; method: string; body: Body } } rawRequest
+ * @returns {Promise<string>}
+ */
+function lookupOrPerform(rawRequest) {
+  return new Promise((resolve, reject) => {
+    const request = toRequest(rawRequest);
+    const responsePath = fullPath(request);
+
+    if (fs.existsSync(responsePath)) {
+      // console.log("Skipping request, found file.");
+      resolve(responsePath);
+    } else {
+      undici.stream(
+        request.url,
+        {
+          method: request.method,
+          body: request.body,
+          headers: {
+            "User-Agent": "request",
+            ...request.headers,
+          },
+        },
+        (response) => {
+          const writeStream = fs.createWriteStream(responsePath);
+          writeStream.on("finish", async () => {
+            resolve(responsePath);
+          });
+
+          return writeStream;
+        }
+      );
+    }
+  });
+}
+
+/**
+ * @param {{url: string; headers: {[x: string]: string}; method: string; body: Body } } elmRequest
+ */
+function toRequest(elmRequest) {
+  const elmHeaders = Object.fromEntries(elmRequest.headers);
+  let contentType = toContentType(elmRequest.body);
+  let headers = { ...contentType, ...elmHeaders };
+  return {
+    url: elmRequest.url,
+    method: elmRequest.method,
+    headers,
+    body: toBody(elmRequest.body),
+  };
+}
+
+/**
+ * @param {Body} body
+ */
+function toBody(body) {
+  switch (body.tag) {
+    case "EmptyBody": {
+      return null;
+    }
+    case "StringBody": {
+      return body.args[1];
+    }
+    case "JsonBody": {
+      return JSON.stringify(body.args[0]);
+    }
+  }
+}
+
+/**
+ * @param {Body} body
+ * @returns Object
+ */
+function toContentType(body) {
+  switch (body.tag) {
+    case "EmptyBody": {
+      return {};
+    }
+    case "StringBody": {
+      return { "Content-Type": body.args[0] };
+    }
+    case "JsonBody": {
+      return { "Content-Type": "application/json" };
+    }
+  }
+}
+
+/** @typedef { { tag: 'EmptyBody'} | { tag: 'StringBody'; args: [string, string] } | {tag: 'JsonBody'; args: [ Object ] } } Body  */
+
+module.exports = { lookupOrPerform };

package-lock.json

@@ -21,8 +21,10 @@
         "kleur": "^4.1.4",
         "micromatch": "^4.0.4",
         "node-worker-threads-pool": "^1.5.0",
+        "object-hash": "^2.2.0",
         "serve-static": "^1.14.1",
         "terser": "^5.7.0",
+        "undici": "^4.1.0",
         "xhr2": "^0.2.1"
       },
       "bin": {
@@ -4369,6 +4371,14 @@
         "node": ">=0.10.0"
       }
     },
+    "node_modules/object-hash": {
+      "version": "2.2.0",
+      "resolved": "https://registry.npmjs.org/object-hash/-/object-hash-2.2.0.tgz",
+      "integrity": "sha512-gScRMn0bS5fH+IuwyIFgnh9zBdo4DV+6GhygmWM9HyNJSgS0hScp1f5vjtm7oIIOiT9trXrShAkLFSc2IqKNgw==",
+      "engines": {
+        "node": ">= 6"
+      }
+    },
     "node_modules/on-finished": {
       "version": "2.3.0",
       "resolved": "https://registry.npmjs.org/on-finished/-/on-finished-2.3.0.tgz",
@@ -5728,6 +5738,14 @@
         "node": ">=4.2.0"
       }
     },
+    "node_modules/undici": {
+      "version": "4.1.0",
+      "resolved": "https://registry.npmjs.org/undici/-/undici-4.1.0.tgz",
+      "integrity": "sha512-Y1e/pSDLtNT4nXSQc4C7eiqoiV7pq8QmsvD7/6cbUuUER0MewR3xwBswYiHYWqVI4FcUptjHixrdqW4xrmo4uA==",
+      "engines": {
+        "node": ">=12.18"
+      }
+    },
     "node_modules/universalify": {
       "version": "2.0.0",
       "resolved": "https://registry.npmjs.org/universalify/-/universalify-2.0.0.tgz",
@@ -9556,6 +9574,11 @@
       "integrity": "sha1-IQmtx5ZYh8/AXLvUQsrIv7s2CGM=",
       "dev": true
     },
+    "object-hash": {
+      "version": "2.2.0",
+      "resolved": "https://registry.npmjs.org/object-hash/-/object-hash-2.2.0.tgz",
+      "integrity": "sha512-gScRMn0bS5fH+IuwyIFgnh9zBdo4DV+6GhygmWM9HyNJSgS0hScp1f5vjtm7oIIOiT9trXrShAkLFSc2IqKNgw=="
+    },
     "on-finished": {
       "version": "2.3.0",
       "resolved": "https://registry.npmjs.org/on-finished/-/on-finished-2.3.0.tgz",
@@ -10616,6 +10639,11 @@
       "integrity": "sha512-V+evlYHZnQkaz8TRBuxTA92yZBPotr5H+WhQ7bD3hZUndx5tGOa1fuCgeSjxAzM1RiN5IzvadIXTVefuuwZCRg==",
       "dev": true
     },
+    "undici": {
+      "version": "4.1.0",
+      "resolved": "https://registry.npmjs.org/undici/-/undici-4.1.0.tgz",
+      "integrity": "sha512-Y1e/pSDLtNT4nXSQc4C7eiqoiV7pq8QmsvD7/6cbUuUER0MewR3xwBswYiHYWqVI4FcUptjHixrdqW4xrmo4uA=="
+    },
     "universalify": {
       "version": "2.0.0",
       "resolved": "https://registry.npmjs.org/universalify/-/universalify-2.0.0.tgz",

package.json

@@ -35,8 +35,10 @@
     "kleur": "^4.1.4",
     "micromatch": "^4.0.4",
     "node-worker-threads-pool": "^1.5.0",
+    "object-hash": "^2.2.0",
     "serve-static": "^1.14.1",
     "terser": "^5.7.0",
+    "undici": "^4.1.0",
     "xhr2": "^0.2.1"
   },
   "devDependencies": {

src/Pages/Internal/Platform/Cli.elm

@@ -33,6 +33,7 @@ import Pages.Internal.Platform.StaticResponses as StaticResponses exposing (Stat
 import Pages.Internal.Platform.ToJsPayload as ToJsPayload exposing (ToJsSuccessPayload)
 import Pages.Internal.StaticHttpBody as StaticHttpBody
 import Pages.ProgramConfig exposing (ProgramConfig)
+import Pages.StaticHttp.Request
 import Pages.StaticHttpRequest as StaticHttpRequest
 import Path exposing (Path)
 import RenderRequest exposing (RenderRequest)
@@ -143,6 +144,22 @@ cliApplication config =
                                                             )
                                                             |> Decode.map GotGlob
 
+                                                    "GotHttp" ->
+                                                        Decode.field "data"
+                                                            (Decode.map2
+                                                                (\requests response ->
+                                                                    GotStaticHttpResponse
+                                                                        { request =
+                                                                            { masked = requests.masked
+                                                                            , unmasked = requests.unmasked
+                                                                            }
+                                                                        , response = Ok response
+                                                                        }
+                                                                )
+                                                                (Decode.field "request" requestDecoder)
+                                                                (Decode.field "result" Decode.string)
+                                                            )
+
                                                     _ ->
                                                         Decode.fail "Unhandled msg"
                                             )
@@ -154,6 +171,16 @@ cliApplication config =
         }
 
 
+requestDecoder : Decode.Decoder { masked : Pages.StaticHttp.Request.Request, unmasked : Pages.StaticHttp.Request.Request }
+requestDecoder =
+    (Codec.object (\masked unmasked -> { masked = masked, unmasked = unmasked })
+        |> Codec.field "masked" .masked Pages.StaticHttp.Request.codec
+        |> Codec.field "unmasked" .unmasked Pages.StaticHttp.Request.codec
+        |> Codec.buildObject
+    )
+        |> Codec.decoder
+
+
 gotStaticFileDecoder : Decode.Decoder ( String, Decode.Value )
 gotStaticFileDecoder =
     Decode.field "data"
@@ -248,40 +275,10 @@ perform renderRequest config toJsPort effect =
                     |> Cmd.map never
 
             else
-                Cmd.batch
+                ToJsPayload.DoHttp { masked = masked, unmasked = unmasked }
-                    [ Http.request
+                    |> Codec.encoder (ToJsPayload.successCodecNew2 canonicalSiteUrl "")
-                        { method = unmasked.method
+                    |> toJsPort
-                        , url = unmasked.url
-                        , headers = unmasked.headers |> List.map (\( key, value ) -> Http.header key value)
-                        , body =
-                            case unmasked.body of
-                                StaticHttpBody.EmptyBody ->
-                                    Http.emptyBody
-
-                                StaticHttpBody.StringBody contentType string ->
-                                    Http.stringBody contentType string
-
-                                StaticHttpBody.JsonBody value ->
-                                    Http.jsonBody value
-                        , expect =
-                            Pages.Http.expectString
-                                (\response ->
-                                    GotStaticHttpResponse
-                                        { request = requests
-                                        , response = response
-                                        }
-                                )
-                        , timeout = Nothing
-                        , tracker = Nothing
-                        }
-                    , toJsPort
-                        (Json.Encode.object
-                            [ ( "command", Json.Encode.string "log" )
-                            , ( "value", Json.Encode.string ("Fetching " ++ unmasked.method ++ " " ++ masked.url) )
-                            ]
-                        )
                     |> Cmd.map never
-                    ]
 
         Effect.SendSinglePage done info ->
             let
@@ -498,7 +495,10 @@ update contentCache config msg model =
                             { model
                                 | pendingRequests =
                                     model.pendingRequests
-                                        |> List.filter (\pending -> pending /= request)
+                                        |> List.filter
+                                            (\pending ->
+                                                pending /= request
+                                            )
                             }
 
                         Err error ->

src/Pages/Internal/Platform/ToJsPayload.elm

@@ -16,6 +16,7 @@ import Dict exposing (Dict)
 import Head
 import Json.Decode as Decode
 import Json.Encode
+import Pages.StaticHttp.Request
 
 
 type ToJsPayload
@@ -184,6 +185,7 @@ type ToJsSuccessPayloadNewCombined
     | SendApiResponse { body : String, staticHttpCache : Dict String String, statusCode : Int }
     | ReadFile String
     | Glob String
+    | DoHttp { masked : Pages.StaticHttp.Request.Request, unmasked : Pages.StaticHttp.Request.Request }
     | Port String
 
 
@@ -195,7 +197,7 @@ type alias InitialDataRecord =
 successCodecNew2 : String -> String -> Codec ToJsSuccessPayloadNewCombined
 successCodecNew2 canonicalSiteUrl currentPagePath =
     Codec.custom
-        (\success initialData vReadFile vGlob vSendApiResponse vPort value ->
+        (\success initialData vReadFile vGlob vDoHttp vSendApiResponse vPort value ->
             case value of
                 PageProgress payload ->
                     success payload
@@ -209,6 +211,9 @@ successCodecNew2 canonicalSiteUrl currentPagePath =
                 Glob globPattern ->
                     vGlob globPattern
 
+                DoHttp requestUrl ->
+                    vDoHttp requestUrl
+
                 SendApiResponse record ->
                     vSendApiResponse record
 
@@ -219,6 +224,13 @@ successCodecNew2 canonicalSiteUrl currentPagePath =
         |> Codec.variant1 "InitialData" InitialData initialDataCodec
         |> Codec.variant1 "ReadFile" ReadFile Codec.string
         |> Codec.variant1 "Glob" Glob Codec.string
+        |> Codec.variant1 "DoHttp"
+            DoHttp
+            (Codec.object (\masked unmasked -> { masked = masked, unmasked = unmasked })
+                |> Codec.field "masked" .masked Pages.StaticHttp.Request.codec
+                |> Codec.field "unmasked" .unmasked Pages.StaticHttp.Request.codec
+                |> Codec.buildObject
+            )
         |> Codec.variant1 "ApiResponse"
             SendApiResponse
             (Codec.object (\body staticHttpCache statusCode -> { body = body, staticHttpCache = staticHttpCache, statusCode = statusCode })

src/Pages/Internal/StaticHttpBody.elm

@@ -1,5 +1,6 @@
-module Pages.Internal.StaticHttpBody exposing (Body(..), encode)
+module Pages.Internal.StaticHttpBody exposing (Body(..), codec, encode)
 
+import Codec exposing (Codec)
 import Json.Encode as Encode
 
 
@@ -31,3 +32,23 @@ encodeWithType typeName otherFields =
     Encode.object <|
         ( "type", Encode.string typeName )
             :: otherFields
+
+
+codec : Codec Body
+codec =
+    Codec.custom
+        (\vEmpty vString vJson value ->
+            case value of
+                EmptyBody ->
+                    vEmpty
+
+                StringBody a b ->
+                    vString a b
+
+                JsonBody body ->
+                    vJson body
+        )
+        |> Codec.variant0 "EmptyBody" EmptyBody
+        |> Codec.variant2 "StringBody" StringBody Codec.string Codec.string
+        |> Codec.variant1 "JsonBody" JsonBody Codec.value
+        |> Codec.buildCustom

src/Pages/StaticHttp/Request.elm

@@ -1,5 +1,6 @@
-module Pages.StaticHttp.Request exposing (Request, hash)
+module Pages.StaticHttp.Request exposing (Request, codec, hash)
 
+import Codec exposing (Codec)
 import Json.Encode as Encode
 import Pages.Internal.StaticHttpBody as StaticHttpBody exposing (Body)
 
@@ -26,3 +27,13 @@ hash requestDetails =
 hashHeader : ( String, String ) -> Encode.Value
 hashHeader ( name, value ) =
     Encode.string <| name ++ ": " ++ value
+
+
+codec : Codec Request
+codec =
+    Codec.object Request
+        |> Codec.field "url" .url Codec.string
+        |> Codec.field "method" .method Codec.string
+        |> Codec.field "headers" .headers (Codec.list (Codec.tuple Codec.string Codec.string))
+        |> Codec.field "body" .body StaticHttpBody.codec
+        |> Codec.buildObject