dillonkearns/elm-pages-v3-beta
1
1
Fork 0
mirror of https://github.com/dillonkearns/elm-pages-v3-beta.git synced 2024-11-24 06:54:03 +03:00
Code Issues Packages Projects Releases Wiki Activity

Merge pull request #7 from dillonkearns/json-data-optimization

Browse Source 
Avoid creating unnecessary Elm Dicts by directly using JSON values fo…
This commit is contained in:
Dillon Kearns 2023-01-06 18:19:11 -08:00 committed by GitHub
commit 33fc85b1b8
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
21 changed files with 1831 additions and 312 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
cypress/e2e/glob-data-source.cy.ts
View File

@ -1,5 +1,5 @@
it(`glob tests`, () => {
cy.visit("/tests");
cy.contains("All tests passed");
cy.document().should("not.include.text", "Expected");
cy.get(".test-pass").should("exist");
cy.get(".test-fail").should("not.exist");
});

5
cypress/e2e/http-backend-task.cy.ts Normal file
View File

@ -0,0 +1,5 @@
it(`BackendTask tests`, () => {
cy.visit("/http-tests");
cy.get(".test-pass").should("exist");
cy.get(".test-fail").should("not.exist");
});

2
docs.json
View File

File diff suppressed because one or more lines are too long

10
examples/end-to-end/app/Api.elm
View File

@ -16,6 +16,7 @@ import Route exposing (Route)
import Server.Request as Request
import Server.Response as Response exposing (Response)
import Test.Glob
import Test.HttpRequests
import Test.Runner.Html
import Time
import Xml.Decode
@ -43,6 +44,15 @@ routes getStaticRoutes htmlToString =
)
|> ApiRoute.literal "tests"
|> ApiRoute.serverRender
, ApiRoute.succeed
(Request.succeed
(Test.HttpRequests.all
|> BackendTask.map viewHtmlResults
|> BackendTask.map html
)
)
|> ApiRoute.literal "http-tests"
|> ApiRoute.serverRender
, requestPrinter
, xmlDecoder
, multipleContentTypes

128
examples/end-to-end/src/Test/HttpRequests.elm Normal file
View File

@ -0,0 +1,128 @@
module Test.HttpRequests exposing (all)
import BackendTask exposing (BackendTask)
import BackendTask.Http
import Exception exposing (Catchable)
import Expect
import Json.Decode as Decode
import Test exposing (Test)
all : BackendTask error Test
all =
[ BackendTask.Http.get "http://httpstat.us/500" (Decode.succeed ())
|> test "http 500 error"
(\result ->
case result of
Err error ->
case error of
BackendTask.Http.BadStatus metadata string ->
metadata.statusCode
|> Expect.equal 500
_ ->
Expect.fail ("Expected BadStatus, got :" ++ Debug.toString error)
Ok () ->
Expect.fail "Expected HTTP error, got Ok"
)
, BackendTask.Http.get "http://httpstat.us/404" (Decode.succeed ())
|> test "http 404 error"
(\result ->
case result of
Err error ->
case error of
BackendTask.Http.BadStatus metadata string ->
metadata.statusCode
|> Expect.equal 404
_ ->
Expect.fail ("Expected BadStatus, got: " ++ Debug.toString error)
Ok () ->
Expect.fail "Expected HTTP error, got Ok"
)
, BackendTask.Http.get "https://api.github.com/repos/dillonkearns/elm-pages" (Decode.field "stargazers_count" Decode.int)
|> test "200 JSON"
(\result ->
case result of
Err error ->
Expect.fail ("Expected BadStatus, got: " ++ Debug.toString error)
Ok count ->
Expect.pass
)
, BackendTask.Http.get "https://api.github.com/repos/dillonkearns/elm-pages" (Decode.field "this-field-doesn't-exist" Decode.int)
|> test "JSON decoding error"
(\result ->
case result of
Err (BackendTask.Http.BadBody (Just (Decode.Failure failureString _)) _) ->
failureString
|> Expect.equal "Expecting an OBJECT with a field named `this-field-doesn't-exist`"
_ ->
Expect.fail ("Expected BadStatus, got: " ++ Debug.toString result)
)
, BackendTask.Http.requestWithOptions
{ url = "https://api.github.com/repos/dillonkearns/elm-pages"
, method = "GET"
, headers = []
, body = BackendTask.Http.emptyBody
}
{ cacheStrategy = BackendTask.Http.IgnoreCache
, retries = 0
, timeoutInMs = Nothing
}
(BackendTask.Http.expectJson
(Decode.field "this-field-doesn't-exist" Decode.int)
)
|> test "cache options"
(\result ->
case result of
Err (BackendTask.Http.BadBody (Just (Decode.Failure failureString _)) _) ->
failureString
|> Expect.equal "Expecting an OBJECT with a field named `this-field-doesn't-exist`"
_ ->
Expect.fail ("Expected BadStatus, got: " ++ Debug.toString result)
)
, BackendTask.Http.requestWithOptions
{ url = "https://api.github.com/repos/dillonkearns/elm-pages"
, method = "GET"
, headers = []
, body = BackendTask.Http.emptyBody
}
{ cacheStrategy = BackendTask.Http.ForceRevalidate
, retries = 0
, timeoutInMs = Nothing
}
(BackendTask.Http.withMetadata
(BackendTask.Http.expectJson
(Decode.field "stargazers_count" Decode.int)
)
)
|> test "with metadata"
(\result ->
case result of
Ok ( metadata, stars ) ->
metadata.statusCode
|> Expect.equal 200
_ ->
Expect.fail ("Expected Ok, got: " ++ Debug.toString result)
)
]
|> BackendTask.combine
|> BackendTask.map (Test.describe "BackendTask tests")
test : String -> (Result error data -> Expect.Expectation) -> BackendTask (Catchable error) data -> BackendTask noError Test
test name assert task =
task
|> BackendTask.toResult
|> BackendTask.map
(\result ->
Test.test name <|
\() ->
assert result
)

2
examples/todos/app/Route/Login.elm
View File

@ -468,7 +468,7 @@ sendEmail :
-> SendGrid.Email
-> BackendTask (Result SendGrid.Error ())
sendEmail apiKey_ email_ =
BackendTask.Http.uncachedRequest
BackendTask.Http.requestWithOptions
{ method = "POST"
, headers = [ ( "Authorization", "Bearer " ++ apiKey_ ) ]
, url = SendGrid.sendGridApiUrl

4
examples/todos/src/Request/Hasura.elm
View File

@ -15,7 +15,7 @@ backendTask selectionSet =
BackendTask.Env.expect "SMOOTHIES_HASURA_SECRET"
|> BackendTask.andThen
(\hasuraSecret ->
BackendTask.Http.uncachedRequest
BackendTask.Http.requestWithOptions
{ url = hasuraUrl
, method = "POST"
, headers = [ ( "x-hasura-admin-secret", hasuraSecret ) ]
@ -42,7 +42,7 @@ mutationBackendTask selectionSet =
BackendTask.Env.expect "SMOOTHIES_HASURA_SECRET"
|> BackendTask.andThen
(\hasuraSecret ->
BackendTask.Http.uncachedRequest
BackendTask.Http.requestWithOptions
{ url = hasuraUrl
, method = "POST"
, headers = [ ( "x-hasura-admin-secret", hasuraSecret ) ]

54
generator/src/render.js
View File

@ -16,7 +16,7 @@ process.on("unhandledRejection", (error) => {
console.error(error);
});
let foundErrors;
let pendingBackendTaskResponses;
let pendingBackendTaskResponses = new Map();
let pendingBackendTaskCount;
module.exports = { render, runGenerator };
@ -44,7 +44,7 @@ async function render(
const { fs, resetInMemoryFs } = require("./request-cache-fs.js")(hasFsAccess);
resetInMemoryFs();
foundErrors = false;
pendingBackendTaskResponses = [];
pendingBackendTaskResponses = new Map();
pendingBackendTaskCount = 0;
// since init/update are never called in pre-renders, and BackendTask.Http is called using pure NodeJS HTTP fetching
// we can provide a fake HTTP instead of xhr2 (which is otherwise needed for Elm HTTP requests from Node)
@ -74,7 +74,7 @@ async function runGenerator(cliOptions, portsFile, elmModule) {
const { fs, resetInMemoryFs } = require("./request-cache-fs.js")(true);
resetInMemoryFs();
foundErrors = false;
pendingBackendTaskResponses = [];
pendingBackendTaskResponses = new Map();
pendingBackendTaskCount = 0;
// since init/update are never called in pre-renders, and BackendTask.Http is called using pure NodeJS HTTP fetching
// we can provide a fake HTTP instead of xhr2 (which is otherwise needed for Elm HTTP requests from Node)
@ -178,12 +178,14 @@ function runGeneratorAppHelp(
);
}
} else if (fromElm.tag === "DoHttp") {
const requestToPerform = fromElm.args[0];
const requestHash = fromElm.args[0];
const requestToPerform = fromElm.args[1];
if (
requestToPerform.url !== "elm-pages-internal://port" &&
requestToPerform.url.startsWith("elm-pages-internal://")
) {
runInternalJob(
requestHash,
app,
mode,
requestToPerform,
@ -193,6 +195,7 @@ function runGeneratorAppHelp(
);
} else {
runHttpJob(
requestHash,
portsFile,
app,
mode,
@ -318,12 +321,14 @@ function runElmApp(
);
}
} else if (fromElm.tag === "DoHttp") {
const requestToPerform = fromElm.args[0];
const requestHash = fromElm.args[0];
const requestToPerform = fromElm.args[1];
if (
requestToPerform.url !== "elm-pages-internal://port" &&
requestToPerform.url.startsWith("elm-pages-internal://")
) {
runInternalJob(
requestHash,
app,
mode,
requestToPerform,
@ -333,6 +338,7 @@ function runElmApp(
);
} else {
runHttpJob(
requestHash,
portsFile,
app,
mode,
@ -401,6 +407,7 @@ async function outputString(
/** @typedef { { head: any[]; errors: any[]; contentJson: any[]; html: string; route: string; title: string; } } Arg */
async function runHttpJob(
requestHash,
portsFile,
app,
mode,
@ -421,14 +428,14 @@ async function runHttpJob(
if (lookupResponse.kind === "cache-response-path") {
const responseFilePath = lookupResponse.value;
pendingBackendTaskResponses.push({
pendingBackendTaskResponses.set(requestHash, {
request: requestToPerform,
response: JSON.parse(
(await fs.promises.readFile(responseFilePath, "utf8")).toString()
),
});
} else if (lookupResponse.kind === "response-json") {
pendingBackendTaskResponses.push({
pendingBackendTaskResponses.set(requestHash, {
request: requestToPerform,
response: lookupResponse.value,
});
@ -457,6 +464,7 @@ function jsonResponse(request, json) {
}
async function runInternalJob(
requestHash,
app,
mode,
requestToPerform,
@ -468,29 +476,40 @@ async function runInternalJob(
pendingBackendTaskCount += 1;
if (requestToPerform.url === "elm-pages-internal://log") {
pendingBackendTaskResponses.push(await runLogJob(requestToPerform));
pendingBackendTaskResponses.set(
requestHash,
await runLogJob(requestToPerform)
);
} else if (requestToPerform.url === "elm-pages-internal://read-file") {
pendingBackendTaskResponses.push(
pendingBackendTaskResponses.set(
requestHash,
await readFileJobNew(requestToPerform, patternsToWatch)
);
} else if (requestToPerform.url === "elm-pages-internal://glob") {
pendingBackendTaskResponses.push(
pendingBackendTaskResponses.set(
requestHash,
await runGlobNew(requestToPerform, patternsToWatch)
);
} else if (requestToPerform.url === "elm-pages-internal://env") {
pendingBackendTaskResponses.push(
pendingBackendTaskResponses.set(
requestHash,
await runEnvJob(requestToPerform, patternsToWatch)
);
} else if (requestToPerform.url === "elm-pages-internal://encrypt") {
pendingBackendTaskResponses.push(
pendingBackendTaskResponses.set(
requestHash,
await runEncryptJob(requestToPerform, patternsToWatch)
);
} else if (requestToPerform.url === "elm-pages-internal://decrypt") {
pendingBackendTaskResponses.push(
pendingBackendTaskResponses.set(
requestHash,
await runDecryptJob(requestToPerform, patternsToWatch)
);
} else if (requestToPerform.url === "elm-pages-internal://write-file") {
pendingBackendTaskResponses.push(await runWriteFileJob(requestToPerform));
pendingBackendTaskResponses.set(
requestHash,
await runWriteFileJob(requestToPerform)
);
} else {
throw `Unexpected internal BackendTask request format: ${kleur.yellow(
JSON.stringify(2, null, requestToPerform)
@ -623,7 +642,7 @@ async function runDecryptJob(req, patternsToWatch) {
function flushIfDone(app) {
if (foundErrors) {
pendingBackendTaskResponses = [];
pendingBackendTaskResponses = new Map();
} else if (pendingBackendTaskCount === 0) {
// console.log(
// `Flushing ${pendingBackendTaskResponses.length} items in ${timeUntilThreshold}ms`
@ -634,10 +653,9 @@ function flushIfDone(app) {
}
function flushQueue(app) {
const temp = pendingBackendTaskResponses;
pendingBackendTaskResponses = [];
app.ports.gotBatchSub.send(Object.fromEntries(pendingBackendTaskResponses));
pendingBackendTaskResponses = new Map();
// console.log("@@@ FLUSHING", temp.length);
app.ports.gotBatchSub.send(temp);
}
/**

94
generator/src/request-cache.js
View File

@ -1,5 +1,4 @@
const path = require("path");
const fetch = require("node-fetch");
const objectHash = require("object-hash");
const kleur = require("kleur");
@ -44,6 +43,10 @@ function fullPath(portsHash, request, hasFsAccess) {
* @returns {Promise<Response>}
*/
function lookupOrPerform(portsFile, mode, rawRequest, hasFsAccess, useCache) {
const fetch = require("make-fetch-happen").defaults({
cachePath: "./.elm-pages/http-cache",
cache: mode === "build" ? "no-cache" : "default",
});
const { fs } = require("./request-cache-fs.js")(hasFsAccess);
return new Promise(async (resolve, reject) => {
const request = toRequest(rawRequest);
@ -146,62 +149,59 @@ function lookupOrPerform(portsFile, mode, rawRequest, hasFsAccess, useCache) {
"User-Agent": "request",
...request.headers,
},
...rawRequest.useCache,
});
console.timeEnd(`fetch ${request.url}`);
const expectString = request.headers["elm-pages-internal"];
if (response.ok || expectString === "ExpectResponse") {
let body;
let bodyKind;
if (expectString === "ExpectJson") {
body = await response.json();
let body;
let bodyKind;
if (expectString === "ExpectJson") {
try {
body = await response.buffer();
body = JSON.parse(body.toString("utf-8"));
bodyKind = "json";
} else if (
expectString === "ExpectBytes" ||
expectString === "ExpectBytesResponse"
) {
bodyKind = "bytes";
const arrayBuffer = await response.arrayBuffer();
body = Buffer.from(arrayBuffer).toString("base64");
} else if (expectString === "ExpectWhatever") {
bodyKind = "whatever";
body = null;
} else if (
expectString === "ExpectResponse" ||
expectString === "ExpectString"
) {
} catch (error) {
body = body.toString("utf8");
bodyKind = "string";
body = await response.text();
} else {
throw `Unexpected expectString ${expectString}`;
}
await fs.promises.writeFile(
responsePath,
JSON.stringify({
headers: Object.fromEntries(response.headers.entries()),
statusCode: response.status,
body: body,
bodyKind,
url: response.url,
statusText: response.statusText,
})
);
resolve({ kind: "cache-response-path", value: responsePath });
} else if (
expectString === "ExpectBytes" ||
expectString === "ExpectBytesResponse"
) {
body = await response.buffer();
try {
body = body.toString("base64");
bodyKind = "bytes";
} catch (e) {
body = body.toString("utf8");
bodyKind = "string";
}
} else if (expectString === "ExpectWhatever") {
bodyKind = "whatever";
body = null;
} else if (
expectString === "ExpectResponse" ||
expectString === "ExpectString"
) {
bodyKind = "string";
body = await response.text();
} else {
console.log("@@@ request-cache1 bad HTTP response");
reject({
title: "BackendTask.Http Error",
message: `${kleur
.yellow()
.underline(request.url)} Bad HTTP response ${response.status} ${
response.statusText
}
`,
});
throw `Unexpected expectString ${expectString}`;
}
resolve({
kind: "response-json",
value: {
headers: Object.fromEntries(response.headers.entries()),
statusCode: response.status,
body,
bodyKind,
url: response.url,
statusText: response.statusText,
},
});
} catch (error) {
console.trace("@@@ request-cache2 HTTP error", error);
reject({

1351
package-lock.json generated
View File

File diff suppressed because it is too large Load Diff

4
package.json
View File

@ -39,6 +39,7 @@
"gray-matter": "^4.0.3",
"jsesc": "^3.0.2",
"kleur": "^4.1.5",
"make-fetch-happen": "^11.0.2",
"memfs": "^3.4.7",
"micromatch": "^4.0.5",
"node-fetch": "^2.6.7",
@ -51,6 +52,7 @@
"devDependencies": {
"@types/cross-spawn": "^6.0.2",
"@types/fs-extra": "^9.0.13",
"@types/make-fetch-happen": "^10.0.1",
"@types/micromatch": "^4.0.2",
"@types/node": "^18.11.9",
"@types/serve-static": "^1.15.0",
@ -77,4 +79,4 @@
"bin": {
"elm-pages": "generator/src/cli.js"
}
}
}

19
src/BackendTask.elm
View File

@ -5,7 +5,7 @@ module BackendTask exposing
, andThen, resolve, combine
, andMap
, map2, map3, map4, map5, map6, map7, map8, map9
, catch, throw, mapError, onError
, catch, throw, mapError, onError, toResult
)
{-| In an `elm-pages` app, each Route Module can define a value `data` which is a `BackendTask` that will be resolved **before** `init` is called. That means it is also available
@ -82,12 +82,12 @@ Any place in your `elm-pages` app where the framework lets you pass in a value o
## Exception Handling
@docs catch, throw, mapError, onError
@docs catch, throw, mapError, onError, toResult
-}
import Dict
import Exception exposing (Catchable(..), Throwable)
import Json.Encode
import Pages.StaticHttpRequest exposing (RawRequest(..))
@ -276,7 +276,7 @@ andThen fn requestInfo =
Request urls lookupFn ->
if List.isEmpty urls then
andThen fn (lookupFn Nothing Dict.empty)
andThen fn (lookupFn Nothing (Json.Encode.object []))
else
Request urls
@ -301,7 +301,7 @@ onError fromError backendTask =
Request urls lookupFn ->
if List.isEmpty urls then
onError fromError (lookupFn Nothing Dict.empty)
onError fromError (lookupFn Nothing (Json.Encode.object []))
else
Request urls
@ -540,3 +540,12 @@ throw : BackendTask (Catchable error) data -> BackendTask Throwable data
throw backendTask =
backendTask
|> onError (Exception.throw >> fail)
{-| -}
toResult : BackendTask (Catchable error) data -> BackendTask noError (Result error data)
toResult backendTask =
backendTask
|> catch
|> andThen (Ok >> succeed)
|> onError (Err >> succeed)

316
src/BackendTask/Http.elm
View File

@ -2,10 +2,10 @@ module BackendTask.Http exposing
( RequestDetails
, get, request
, Expect, expectString, expectJson, expectBytes, expectWhatever
, Response(..), Metadata, Error(..)
, expectStringResponse, expectBytesResponse
, withMetadata, Metadata
, Error(..)
, Body, emptyBody, stringBody, jsonBody
, uncachedRequest
, CacheStrategy(..), requestWithOptions
)
{-| `BackendTask.Http` requests are an alternative to doing Elm HTTP requests the traditional way using the `elm/http` package.
@ -44,11 +44,14 @@ in [this article introducing BackendTask.Http requests and some concepts around
@docs Expect, expectString, expectJson, expectBytes, expectWhatever
## Expecting Responses
## With Metadata
@docs Response, Metadata, Error
@docs withMetadata, Metadata
@docs expectStringResponse, expectBytesResponse
## Errors
@docs Error
## Building a BackendTask.Http Request Body
@ -60,14 +63,14 @@ and describe your use case!
@docs Body, emptyBody, stringBody, jsonBody
## Uncached Requests
## Caching Options
@docs uncachedRequest
@docs CacheStrategy, requestWithOptions
-}
import BackendTask exposing (BackendTask)
import Bytes exposing (Bytes)
import Base64
import Bytes.Decode
import Dict exposing (Dict)
import Exception exposing (Catchable)
@ -164,10 +167,9 @@ as XML, for example, or give an `elm-pages` build error if the response can't be
type Expect value
= ExpectJson (Json.Decode.Decoder value)
| ExpectString (String -> value)
| ExpectResponse (Response String -> value)
| ExpectBytesResponse (Response Bytes -> value)
| ExpectBytes (Bytes.Decode.Decoder value)
| ExpectWhatever value
| ExpectMetadata (Metadata -> Expect value)
{-| Gives the HTTP response body as a raw String.
@ -205,6 +207,29 @@ expectJson =
ExpectJson
{-| -}
withMetadata : Expect value -> Expect ( Metadata, value )
withMetadata originalExpect =
case originalExpect of
ExpectJson jsonDecoder ->
ExpectMetadata (\metadata -> ExpectJson (jsonDecoder |> Json.Decode.map (Tuple.pair metadata)))
ExpectString stringToValue ->
ExpectMetadata
(\metadata ->
ExpectString (\string -> string |> stringToValue |> Tuple.pair metadata)
)
ExpectBytes bytesDecoder ->
ExpectMetadata (\metadata -> ExpectBytes (bytesDecoder |> Bytes.Decode.map (Tuple.pair metadata)))
ExpectWhatever value ->
ExpectMetadata (\metadata -> ExpectWhatever ( metadata, value ))
ExpectMetadata metadataToExpect ->
Debug.todo ""
{-| -}
expectBytes : Bytes.Decode.Decoder value -> Expect value
expectBytes =
@ -217,18 +242,6 @@ expectWhatever =
ExpectWhatever
{-| -}
expectStringResponse : Expect (Response String)
expectStringResponse =
ExpectResponse identity
{-| -}
expectBytesResponse : Expect (Response Bytes)
expectBytesResponse =
ExpectBytesResponse identity
expectToString : Expect a -> String
expectToString expect =
case expect of
@ -238,17 +251,24 @@ expectToString expect =
ExpectString _ ->
"ExpectString"
ExpectResponse _ ->
"ExpectResponse"
ExpectBytes _ ->
"ExpectBytes"
ExpectWhatever _ ->
"ExpectWhatever"
ExpectBytesResponse _ ->
"ExpectBytesResponse"
ExpectMetadata toExpect ->
-- It's safe to call this with fake metadata to get the kind of Expect because the exposed
-- API, `withMetadata`, will never change the type of Expect it returns based on the metadata, it simply
-- wraps the Expect with the additional Metadata.
-- It's important not to expose the raw `ExpectMetadata` constructor however because that would break that guarantee.
toExpect
{ url = ""
, statusCode = 123
, statusText = ""
, headers = Dict.empty
}
|> expectToString
{-| -}
@ -264,18 +284,29 @@ request request__ expect =
, headers = request__.headers
, method = request__.method
, body = request__.body
, useCache = True
, useCache = Nothing
}
in
requestRaw request_ expect
{-| -}
uncachedRequest :
type CacheStrategy
= UseGlobalDefault
| IgnoreCache -- 'no-store'
| ForceRevalidate -- 'no-cache'
| ForceReload -- 'reload'
| ForceCache -- 'force-cache'
| ErrorUnlessCached -- 'only-if-cached'
{-| -}
requestWithOptions :
RequestDetails
-> Options
-> Expect a
-> BackendTask (Catchable Error) a
uncachedRequest request__ expect =
requestWithOptions request__ options expect =
let
request_ : HashRequest.Request
request_ =
@ -283,12 +314,52 @@ uncachedRequest request__ expect =
, headers = request__.headers
, method = request__.method
, body = request__.body
, useCache = False
, useCache = encodeOptions options |> Just
}
in
requestRaw request_ expect
encodeOptions : Options -> Encode.Value
encodeOptions options =
Encode.object
([ ( "cache"
, (case options.cacheStrategy of
UseGlobalDefault ->
Nothing
IgnoreCache ->
Just "no-store"
ForceRevalidate ->
Just "no-cache"
ForceReload ->
Just "reload"
ForceCache ->
Just "force-cache"
ErrorUnlessCached ->
Just "only-if-cached"
)
|> Maybe.map Encode.string
)
, ( "retry", Encode.int options.retries |> Just )
, ( "timeout", options.timeoutInMs |> Maybe.map Encode.int )
]
|> List.filterMap
(\( a, b ) -> b |> Maybe.map (Tuple.pair a))
)
type alias Options =
{ cacheStrategy : CacheStrategy
, retries : Int
, timeoutInMs : Maybe Int
}
{-| Build a `BackendTask.Http` request (analogous to [Http.request](https://package.elm-lang.org/packages/elm/http/latest/Http#request)).
This function takes in all the details to build a `BackendTask.Http` request, but you can build your own simplified helper functions
with this as a low-level detail, or you can use functions like [BackendTask.Http.get](#get).
@ -307,7 +378,7 @@ requestRaw request__ expect =
:: request__.headers
, method = request__.method
, body = request__.body
, useCache = False
, useCache = request__.useCache
}
in
Request
@ -327,81 +398,69 @@ requestRaw request__ expect =
Nothing ->
--Err (Pages.StaticHttpRequest.UserCalledStaticHttpFail ("INTERNAL ERROR - expected request" ++ request_.url))
Err (BadBody ("INTERNAL ERROR - expected request" ++ request_.url))
Err (BadBody Nothing ("INTERNAL ERROR - expected request" ++ request_.url))
)
|> Result.andThen
(\(RequestsAndPending.Response maybeResponse body) ->
case ( expect, body, maybeResponse ) of
( ExpectJson decoder, RequestsAndPending.JsonBody json, _ ) ->
json
|> Json.Decode.decodeValue decoder
|> Result.mapError
(\error ->
error
|> Json.Decode.errorToString
|> BadBody
)
let
maybeBadResponse : Maybe Error
maybeBadResponse =
case maybeResponse of
Just response ->
if not (response.statusCode >= 200 && response.statusCode < 300) then
case body of
RequestsAndPending.StringBody s ->
BadStatus
{ url = response.url
, statusCode = response.statusCode
, statusText = response.statusText
, headers = response.headers
}
s
|> Just
( ExpectString mapStringFn, RequestsAndPending.StringBody string, _ ) ->
string
|> mapStringFn
|> Ok
RequestsAndPending.BytesBody bytes ->
BadStatus
{ url = response.url
, statusCode = response.statusCode
, statusText = response.statusText
, headers = response.headers
}
(Base64.fromBytes bytes |> Maybe.withDefault "")
|> Just
( ExpectResponse mapResponse, RequestsAndPending.StringBody asStringBody, Just rawResponse ) ->
let
asMetadata : Metadata
asMetadata =
{ url = rawResponse.url
, statusCode = rawResponse.statusCode
, statusText = rawResponse.statusText
, headers = rawResponse.headers
}
RequestsAndPending.JsonBody value ->
BadStatus
{ url = response.url
, statusCode = response.statusCode
, statusText = response.statusText
, headers = response.headers
}
(Encode.encode 0 value)
|> Just
rawResponseToResponse : Response String
rawResponseToResponse =
if 200 <= rawResponse.statusCode && rawResponse.statusCode < 300 then
GoodStatus_ asMetadata asStringBody
RequestsAndPending.WhateverBody ->
BadStatus
{ url = response.url
, statusCode = response.statusCode
, statusText = response.statusText
, headers = response.headers
}
""
|> Just
else
BadStatus_ asMetadata asStringBody
in
rawResponseToResponse
|> mapResponse
|> Ok
Nothing
( ExpectBytesResponse mapResponse, RequestsAndPending.BytesBody rawBytesBody, Just rawResponse ) ->
let
asMetadata : Metadata
asMetadata =
{ url = rawResponse.url
, statusCode = rawResponse.statusCode
, statusText = rawResponse.statusText
, headers = rawResponse.headers
}
Nothing ->
Nothing
in
case maybeBadResponse of
Just badResponse ->
Err badResponse
rawResponseToResponse : Response Bytes
rawResponseToResponse =
if 200 <= rawResponse.statusCode && rawResponse.statusCode < 300 then
GoodStatus_ asMetadata rawBytesBody
else
BadStatus_ asMetadata rawBytesBody
in
rawResponseToResponse
|> mapResponse
|> Ok
( ExpectBytes bytesDecoder, RequestsAndPending.BytesBody rawBytes, _ ) ->
rawBytes
|> Bytes.Decode.decode bytesDecoder
|> Result.fromMaybe
(BadBody "Bytes decoding failed.")
( ExpectWhatever whateverValue, RequestsAndPending.WhateverBody, _ ) ->
Ok whateverValue
_ ->
Err (BadBody "Unexpected combination, internal error")
Nothing ->
toResultThing ( expect, body, maybeResponse )
)
|> BackendTask.fromResult
|> BackendTask.mapError
@ -411,6 +470,54 @@ requestRaw request__ expect =
)
toResultThing :
( Expect value
, RequestsAndPending.ResponseBody
, Maybe RequestsAndPending.RawResponse
)
-> Result Error value
toResultThing ( expect, body, maybeResponse ) =
case ( expect, body, maybeResponse ) of
( ExpectMetadata toExpect, _, Just rawResponse ) ->
let
asMetadata : Metadata
asMetadata =
{ url = rawResponse.url
, statusCode = rawResponse.statusCode
, statusText = rawResponse.statusText
, headers = rawResponse.headers
}
in
toResultThing ( toExpect asMetadata, body, maybeResponse )
( ExpectJson decoder, RequestsAndPending.JsonBody json, _ ) ->
json
|> Json.Decode.decodeValue decoder
|> Result.mapError
(\error ->
error
|> Json.Decode.errorToString
|> BadBody (Just error)
)
( ExpectString mapStringFn, RequestsAndPending.StringBody string, _ ) ->
string
|> mapStringFn
|> Ok
( ExpectBytes bytesDecoder, RequestsAndPending.BytesBody rawBytes, _ ) ->
rawBytes
|> Bytes.Decode.decode bytesDecoder
|> Result.fromMaybe
(BadBody Nothing "Bytes decoding failed.")
( ExpectWhatever whateverValue, RequestsAndPending.WhateverBody, _ ) ->
Ok whateverValue
_ ->
Err (BadBody Nothing "Unexpected combination, internal error")
errorToString : Error -> { title : String, body : String }
errorToString error =
{ title = "HTTP Error"
@ -432,7 +539,7 @@ errorToString error =
[ TerminalText.text ("BadStatus: " ++ string)
]
BadBody string ->
BadBody _ string ->
[ TerminalText.text ("BadBody: " ++ string)
]
)
@ -449,19 +556,10 @@ type alias Metadata =
}
{-| -}
type Response body
= BadUrl_ String
| Timeout_
| NetworkError_
| BadStatus_ Metadata body
| GoodStatus_ Metadata body
{-| -}
type Error
= BadUrl String
| Timeout
| NetworkError
| BadStatus Metadata String
| BadBody String
| BadBody (Maybe Json.Decode.Error) String

2
src/BackendTask/Internal/Request.elm
View File

@ -12,7 +12,7 @@ request :
-> BackendTask error a
request ({ name, body, expect } as params) =
-- elm-review: known-unoptimized-recursion
BackendTask.Http.uncachedRequest
BackendTask.Http.request
{ url = "elm-pages-internal://" ++ name
, method = "GET"
, headers = []

50
src/Pages/Internal/Platform/Cli.elm
View File

@ -61,12 +61,7 @@ type alias Model route =
{-| -}
type Msg
= GotDataBatch
(List
{ request : Pages.StaticHttp.Request.Request
, response : RequestsAndPending.Response
}
)
= GotDataBatch Decode.Value
| GotBuildError BuildError
@ -154,35 +149,11 @@ cliApplication config =
)
|> mergeResult
)
, config.gotBatchSub
|> Sub.map
(\newBatch ->
Decode.decodeValue batchDecoder newBatch
|> Result.map GotDataBatch
|> Result.mapError
(\error ->
("From location 2: "
++ (error
|> Decode.errorToString
)
)
|> BuildError.internal
|> GotBuildError
)
|> mergeResult
)
, config.gotBatchSub |> Sub.map GotDataBatch
]
}
batchDecoder : Decode.Decoder (List { request : Pages.StaticHttp.Request.Request, response : RequestsAndPending.Response })
batchDecoder =
Decode.map2 (\request response -> { request = request, response = response })
(Decode.field "request" requestDecoder)
(Decode.field "response" RequestsAndPending.decoder)
|> Decode.list
mergeResult : Result a a -> a
mergeResult r =
case r of
@ -240,7 +211,7 @@ perform site renderRequest config effect =
flatten site renderRequest config list
Effect.FetchHttp unmasked ->
ToJsPayload.DoHttp unmasked unmasked.useCache
ToJsPayload.DoHttp (Pages.StaticHttp.Request.hash unmasked) unmasked
|> Codec.encoder (ToJsPayload.successCodecNew2 canonicalSiteUrl "")
|> config.toJsPort
|> Cmd.map never
@ -295,15 +266,8 @@ flagsDecoder =
, compatibilityKey = compatibilityKey
}
)
--(Decode.field "staticHttpCache"
-- (Decode.dict
-- (Decode.string
-- |> Decode.map Just
-- )
-- )
--)
-- TODO remove hardcoding and decode staticHttpCache here
(Decode.succeed Dict.empty)
(Decode.succeed (Json.Encode.object []))
(Decode.field "mode" Decode.string |> Decode.map (\mode -> mode == "dev-server"))
(Decode.field "compatibilityKey" Decode.int)
@ -346,7 +310,7 @@ init site renderRequest config flags =
, path = ""
}
]
, allRawResponses = Dict.empty
, allRawResponses = Json.Encode.object []
, maybeRequestJson = renderRequest
, isDevServer = False
}
@ -361,7 +325,7 @@ init site renderRequest config flags =
, path = ""
}
]
, allRawResponses = Dict.empty
, allRawResponses = Json.Encode.object []
, maybeRequestJson = renderRequest
, isDevServer = False
}
@ -799,7 +763,7 @@ initLegacy site ((RenderRequest.SinglePage includeHtml singleRequest _) as rende
initialModel =
{ staticResponses = staticResponsesNew
, errors = []
, allRawResponses = Dict.empty
, allRawResponses = Json.Encode.object []
, maybeRequestJson = renderRequest
, isDevServer = isDevServer
}

44
src/Pages/Internal/Platform/GeneratorApplication.elm
View File

@ -14,7 +14,7 @@ import Dict
import Exception exposing (Throwable)
import HtmlPrinter
import Json.Decode as Decode
import Json.Encode
import Json.Encode as Encode
import Pages.GeneratorProgramConfig exposing (GeneratorProgramConfig)
import Pages.Internal.Platform.CompatibilityKey
import Pages.Internal.Platform.Effect as Effect exposing (Effect)
@ -43,12 +43,7 @@ type alias Model =
{-| -}
type Msg
= GotDataBatch
(List
{ request : Pages.StaticHttp.Request.Request
, response : RequestsAndPending.Response
}
)
= GotDataBatch Decode.Value
| GotBuildError BuildError
@ -118,23 +113,7 @@ app config =
)
|> mergeResult
)
, config.gotBatchSub
|> Sub.map
(\newBatch ->
Decode.decodeValue batchDecoder newBatch
|> Result.map GotDataBatch
|> Result.mapError
(\error ->
("From location 2: "
++ (error
|> Decode.errorToString
)
)
|> BuildError.internal
|> GotBuildError
)
|> mergeResult
)
, config.gotBatchSub |> Sub.map GotDataBatch
]
, config = cliConfig
, printAndExitFailure =
@ -151,7 +130,7 @@ app config =
|> Codec.encodeToValue (ToJsPayload.successCodecNew2 "" "")
|> config.toJsPort
|> Cmd.map never
, printAndExitSuccess = \string -> config.toJsPort (Json.Encode.string string) |> Cmd.map never
, printAndExitSuccess = \string -> config.toJsPort (Encode.string string) |> Cmd.map never
}
@ -216,7 +195,7 @@ perform config effect =
flatten config list
Effect.FetchHttp unmasked ->
ToJsPayload.DoHttp unmasked unmasked.useCache
ToJsPayload.DoHttp (Pages.StaticHttp.Request.hash unmasked) unmasked
|> Codec.encoder (ToJsPayload.successCodecNew2 canonicalSiteUrl "")
|> config.toJsPort
|> Cmd.map never
@ -283,7 +262,7 @@ init :
-> ( Model, Effect )
init execute flags =
if flags.compatibilityKey == Pages.Internal.Platform.CompatibilityKey.currentCompatibilityKey then
initLegacy execute { staticHttpCache = Dict.empty }
initLegacy execute
else
let
@ -310,16 +289,15 @@ init execute flags =
, path = ""
}
]
, allRawResponses = Dict.empty
, allRawResponses = Encode.object []
, done = False
}
initLegacy :
BackendTask Throwable ()
-> { staticHttpCache : RequestsAndPending }
-> ( Model, Effect )
initLegacy execute { staticHttpCache } =
initLegacy execute =
let
staticResponses : BackendTask Throwable ()
staticResponses =
@ -329,7 +307,7 @@ initLegacy execute { staticHttpCache } =
initialModel =
{ staticResponses = staticResponses
, errors = []
, allRawResponses = staticHttpCache
, allRawResponses = Encode.object []
, done = False
}
in
@ -390,7 +368,7 @@ nextStepToEffect model nextStep =
updatedModel : Model
updatedModel =
{ model
| allRawResponses = Dict.empty
| allRawResponses = Encode.object []
, staticResponses = updatedStaticResponsesModel
}
in
@ -411,7 +389,7 @@ nextStepToEffect model nextStep =
StaticResponses.Finish () ->
( model
, { body = Json.Encode.null
, { body = Encode.null
, staticHttpCache = Dict.empty
, statusCode = 200
}

27
src/Pages/Internal/Platform/StaticResponses.elm
View File

@ -2,8 +2,8 @@ module Pages.Internal.Platform.StaticResponses exposing (NextStep(..), batchUpda
import BackendTask exposing (BackendTask)
import BuildError exposing (BuildError)
import Dict
import Exception exposing (Catchable(..), Throwable)
import Json.Decode as Decode
import List.Extra
import Pages.StaticHttp.Request as HashRequest
import Pages.StaticHttpRequest as StaticHttpRequest
@ -24,30 +24,17 @@ renderApiRequest request =
batchUpdate :
List
{ request : HashRequest.Request
, response : RequestsAndPending.Response
Decode.Value
->
{ model
| allRawResponses : Decode.Value
}
->
{ model
| allRawResponses : RequestsAndPending
}
->
{ model
| allRawResponses : RequestsAndPending
| allRawResponses : Decode.Value
}
batchUpdate newEntries model =
{ model
| allRawResponses =
newEntries
|> List.map
(\{ request, response } ->
( HashRequest.hash request
, response
)
)
|> Dict.fromList
}
{ model | allRawResponses = newEntries }
type NextStep route value

8
src/Pages/Internal/Platform/ToJsPayload.elm
View File

@ -89,7 +89,7 @@ headCodec canonicalSiteUrl currentPagePath =
type ToJsSuccessPayloadNewCombined
= PageProgress ToJsSuccessPayloadNew
| SendApiResponse { body : Json.Encode.Value, staticHttpCache : Dict String String, statusCode : Int }
| DoHttp Pages.StaticHttp.Request.Request Bool
| DoHttp String Pages.StaticHttp.Request.Request
| Port String
| Errors (List BuildError)
| ApiResponse
@ -109,8 +109,8 @@ successCodecNew2 canonicalSiteUrl currentPagePath =
PageProgress payload ->
success payload
DoHttp requestUrl _ ->
vDoHttp requestUrl requestUrl.useCache
DoHttp hash requestUrl ->
vDoHttp hash requestUrl
SendApiResponse record ->
vSendApiResponse record
@ -123,8 +123,8 @@ successCodecNew2 canonicalSiteUrl currentPagePath =
|> Codec.variant1 "PageProgress" PageProgress (successCodecNew canonicalSiteUrl currentPagePath)
|> Codec.variant2 "DoHttp"
DoHttp
Codec.string
Pages.StaticHttp.Request.codec
Codec.bool
|> Codec.variant1 "ApiResponse"
SendApiResponse
(Codec.object (\body staticHttpCache statusCode -> { body = body, staticHttpCache = staticHttpCache, statusCode = statusCode })

4
src/Pages/StaticHttp/Request.elm
View File

@ -11,7 +11,7 @@ type alias Request =
, method : String
, headers : List ( String, String )
, body : Body
, useCache : Bool
, useCache : Maybe Encode.Value
}
@ -40,5 +40,5 @@ codec =
|> 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.field "useCache" .useCache Codec.bool
|> Codec.nullableField "useCache" .useCache Codec.value
|> Codec.buildObject

3
src/Pages/StaticHttpRequest.elm
View File

@ -2,6 +2,7 @@ module Pages.StaticHttpRequest exposing (Error(..), MockResolver, RawRequest(..)
import BuildError exposing (BuildError)
import Dict
import Json.Encode
import Pages.StaticHttp.Request
import RequestsAndPending exposing (RequestsAndPending)
import TerminalText as Terminal
@ -48,7 +49,7 @@ mockResolve : RawRequest error value -> MockResolver -> Result error value
mockResolve request mockResolver =
case request of
Request _ lookupFn ->
case lookupFn (Just mockResolver) Dict.empty of
case lookupFn (Just mockResolver) (Json.Encode.object []) of
nextRequest ->
mockResolve nextRequest mockResolver

12
src/RequestsAndPending.elm
View File

@ -1,4 +1,4 @@
module RequestsAndPending exposing (RequestsAndPending, Response(..), ResponseBody(..), batchDecoder, bodyEncoder, decoder, get)
module RequestsAndPending exposing (RawResponse, RequestsAndPending, Response(..), ResponseBody(..), batchDecoder, bodyEncoder, decoder, get)
import Base64
import Bytes exposing (Bytes)
@ -10,7 +10,7 @@ import Pages.StaticHttp.Request
type alias RequestsAndPending =
Dict String Response
Decode.Value
type ResponseBody
@ -117,5 +117,9 @@ responseDecoder =
get : String -> RequestsAndPending -> Maybe Response
get key requestsAndPending =
requestsAndPending
|> Dict.get key
Decode.decodeValue
(Decode.field key
(Decode.field "response" decoder)
)
requestsAndPending
|> Result.toMaybe