From 27999b3186afa0145b3b356aea3a0b19badfdcef Mon Sep 17 00:00:00 2001 From: Dillon Kearns Date: Sat, 27 May 2023 10:21:10 -0700 Subject: [PATCH] Migrate away from parser-style Request.Parser. --- codegen/GenerateMain.elm | 5 +- .../blog-engine/app/Route/Admin/Slug_.elm | 75 ++-- .../blog-engine/app/Route/Posts/Slug_.elm | 74 ++-- examples/end-to-end/app/Api.elm | 191 +++++----- examples/end-to-end/app/Route/CookieTest.elm | 21 +- examples/end-to-end/app/Route/DarkMode.elm | 111 +++--- .../end-to-end/app/Route/ErrorHandling.elm | 14 +- examples/end-to-end/app/Route/Fetcher.elm | 92 ++--- examples/end-to-end/app/Route/Form.elm | 44 +-- examples/end-to-end/app/Route/GetForm.elm | 47 +-- examples/end-to-end/app/Route/Greet.elm | 87 +++-- examples/end-to-end/app/Route/Hello.elm | 10 +- examples/end-to-end/app/Route/Login.elm | 113 +++--- examples/end-to-end/app/Route/Logout.elm | 16 +- examples/end-to-end/app/Route/Redirect.elm | 128 ------- .../end-to-end/app/Route/Test/BasicAuth.elm | 64 ++-- .../app/Route/Test/ResponseHeaders.elm | 18 +- .../end-to-end/cypress/e2e/api-routes.cy.ts | 8 +- examples/end-to-end/src/MySession.elm | 32 +- generator/src/RouteBuilder.elm | 66 +--- src/ApiRoute.elm | 34 +- src/FormData.elm | 22 +- src/Internal/Request.elm | 90 ++++- src/Pages/Internal/Platform/Cli.elm | 17 +- src/Pages/ProgramConfig.elm | 5 +- src/Server/Request.elm | 346 +++++++----------- src/Server/Session.elm | 89 +++-- 27 files changed, 828 insertions(+), 991 deletions(-) delete mode 100644 examples/end-to-end/app/Route/Redirect.elm diff --git a/codegen/GenerateMain.elm b/codegen/GenerateMain.elm index b079632a9..d18c0aa62 100644 --- a/codegen/GenerateMain.elm +++ b/codegen/GenerateMain.elm @@ -30,6 +30,7 @@ import Gen.Pages.Internal.RoutePattern import Gen.Pages.Navigation import Gen.Pages.PageUrl import Gen.PagesMsg +import Gen.Server.Request import Gen.Server.Response import Gen.String import Gen.Tuple @@ -629,7 +630,7 @@ otherFile routes phaseString = dataForRoute = Elm.Declare.fn2 "dataForRoute" - ( "requestPayload", Just Gen.Json.Decode.annotation_.value ) + ( "requestPayload", Just Gen.Server.Request.annotation_.request ) ( "maybeRoute", Type.maybe (Type.named [ "Route" ] "Route") |> Just ) (\requestPayload maybeRoute -> Elm.Case.maybe maybeRoute @@ -681,7 +682,7 @@ otherFile routes phaseString = action = Elm.Declare.fn2 "action" - ( "requestPayload", Just Gen.Json.Decode.annotation_.value ) + ( "requestPayload", Just Gen.Server.Request.annotation_.request ) ( "maybeRoute", Type.maybe (Type.named [ "Route" ] "Route") |> Just ) (\requestPayload maybeRoute -> Elm.Case.maybe maybeRoute diff --git a/examples/blog-engine/app/Route/Admin/Slug_.elm b/examples/blog-engine/app/Route/Admin/Slug_.elm index 30144be87..7738a64ca 100644 --- a/examples/blog-engine/app/Route/Admin/Slug_.elm +++ b/examples/blog-engine/app/Route/Admin/Slug_.elm @@ -28,7 +28,7 @@ import Platform.Sub import Post exposing (Post) import Route import RouteBuilder -import Server.Request +import Server.Request exposing (Request) import Server.Response import Shared import UrlPath @@ -99,37 +99,36 @@ type alias ActionData = data : RouteParams - -> Server.Request.Parser (BackendTask.BackendTask FatalError.FatalError (Server.Response.Response Data ErrorPage.ErrorPage)) -data routeParams = - Server.Request.succeed - (if routeParams.slug == "new" then - Server.Response.render - { post = - { slug = "" - , title = "" - , body = "" - , publish = Nothing - } + -> Request + -> BackendTask.BackendTask FatalError.FatalError (Server.Response.Response Data ErrorPage.ErrorPage) +data routeParams request = + if routeParams.slug == "new" then + Server.Response.render + { post = + { slug = "" + , title = "" + , body = "" + , publish = Nothing } - |> BackendTask.succeed - - else - BackendTask.Custom.run "getPost" - (Encode.string routeParams.slug) - (Decode.nullable Post.decoder) - |> BackendTask.allowFatal - |> BackendTask.map - (\maybePost -> - case maybePost of - Just post -> - Server.Response.render - { post = post - } - - Nothing -> - Server.Response.errorPage ErrorPage.NotFound - ) - ) + } + |> BackendTask.succeed + + else + BackendTask.Custom.run "getPost" + (Encode.string routeParams.slug) + (Decode.nullable Post.decoder) + |> BackendTask.allowFatal + |> BackendTask.map + (\maybePost -> + case maybePost of + Just post -> + Server.Response.render + { post = post + } + + Nothing -> + Server.Response.errorPage ErrorPage.NotFound + ) head : RouteBuilder.App Data ActionData RouteParams -> List Head.Tag @@ -173,10 +172,11 @@ view app shared model = action : RouteParams - -> Server.Request.Parser (BackendTask.BackendTask FatalError.FatalError (Server.Response.Response ActionData ErrorPage.ErrorPage)) -action routeParams = - Server.Request.map - (\( formResponse, parsedForm ) -> + -> Request + -> BackendTask.BackendTask FatalError.FatalError (Server.Response.Response ActionData ErrorPage.ErrorPage) +action routeParams request = + case Server.Request.formData formHandlers request of + Just ( formResponse, parsedForm ) -> case parsedForm of Valid Delete -> BackendTask.Custom.run "deletePost" @@ -228,8 +228,9 @@ action routeParams = (Server.Response.render { errors = formResponse } ) - ) - (Server.Request.formData formHandlers) + + Nothing -> + BackendTask.fail (FatalError.fromString "Invalid form response") form : Form.HtmlForm String Post Post msg diff --git a/examples/blog-engine/app/Route/Posts/Slug_.elm b/examples/blog-engine/app/Route/Posts/Slug_.elm index 7538190fa..9f6c8b27a 100644 --- a/examples/blog-engine/app/Route/Posts/Slug_.elm +++ b/examples/blog-engine/app/Route/Posts/Slug_.elm @@ -22,7 +22,7 @@ import PagesMsg exposing (PagesMsg) import Platform.Sub import Post import RouteBuilder -import Server.Request +import Server.Request exposing (Request) import Server.Response import Shared import UrlPath @@ -93,39 +93,38 @@ type alias ActionData = data : RouteParams - -> Server.Request.Parser (BackendTask.BackendTask FatalError.FatalError (Server.Response.Response Data ErrorPage.ErrorPage)) -data routeParams = - Server.Request.succeed - (BackendTask.Custom.run "getPost" - (Encode.string routeParams.slug) - (Decode.nullable Post.decoder) - |> BackendTask.allowFatal - |> BackendTask.andThen - (\maybePost -> - case maybePost of - Just post -> - let - parsed : Result String (List Block) - parsed = - post.body - |> Markdown.Parser.parse - |> Result.mapError (\_ -> "Invalid markdown.") - in - parsed - |> Result.mapError FatalError.fromString - |> Result.map - (\parsedMarkdown -> - Server.Response.render - { body = parsedMarkdown - } - ) - |> BackendTask.fromResult - - Nothing -> - Server.Response.errorPage ErrorPage.NotFound - |> BackendTask.succeed - ) - ) + -> Request + -> BackendTask.BackendTask FatalError.FatalError (Server.Response.Response Data ErrorPage.ErrorPage) +data routeParams request = + BackendTask.Custom.run "getPost" + (Encode.string routeParams.slug) + (Decode.nullable Post.decoder) + |> BackendTask.allowFatal + |> BackendTask.andThen + (\maybePost -> + case maybePost of + Just post -> + let + parsed : Result String (List Block) + parsed = + post.body + |> Markdown.Parser.parse + |> Result.mapError (\_ -> "Invalid markdown.") + in + parsed + |> Result.mapError FatalError.fromString + |> Result.map + (\parsedMarkdown -> + Server.Response.render + { body = parsedMarkdown + } + ) + |> BackendTask.fromResult + + Nothing -> + Server.Response.errorPage ErrorPage.NotFound + |> BackendTask.succeed + ) head : RouteBuilder.App Data ActionData RouteParams -> List Head.Tag @@ -153,6 +152,7 @@ view app shared model = action : RouteParams - -> Server.Request.Parser (BackendTask.BackendTask FatalError.FatalError (Server.Response.Response ActionData ErrorPage.ErrorPage)) -action routeParams = - Server.Request.succeed (BackendTask.succeed (Server.Response.render {})) + -> Request + -> BackendTask.BackendTask FatalError.FatalError (Server.Response.Response ActionData ErrorPage.ErrorPage) +action routeParams request = + BackendTask.succeed (Server.Response.render {}) diff --git a/examples/end-to-end/app/Api.elm b/examples/end-to-end/app/Api.elm index 1fac65e57..c33e87d4a 100644 --- a/examples/end-to-end/app/Api.elm +++ b/examples/end-to-end/app/Api.elm @@ -37,20 +37,18 @@ routes getStaticRoutes htmlToString = in [ greet , ApiRoute.succeed - (Request.succeed - (Test.Glob.all + (\request -> + Test.Glob.all |> BackendTask.map viewHtmlResults |> BackendTask.map html - ) ) |> ApiRoute.literal "tests" |> ApiRoute.serverRender , ApiRoute.succeed - (Request.succeed - (Test.HttpRequests.all + (\request -> + Test.HttpRequests.all |> BackendTask.map viewHtmlResults |> BackendTask.map html - ) ) |> ApiRoute.literal "http-tests" |> ApiRoute.serverRender @@ -64,12 +62,10 @@ routes getStaticRoutes htmlToString = errorRoute : ApiRoute ApiRoute.Response errorRoute = ApiRoute.succeed - (\errorCode -> - Request.succeed - (Response.plainText ("Here is the error code you requested (" ++ errorCode ++ ")") - |> Response.withStatusCode (String.toInt errorCode |> Maybe.withDefault 500) - |> BackendTask.succeed - ) + (\errorCode request -> + Response.plainText ("Here is the error code you requested (" ++ errorCode ++ ")") + |> Response.withStatusCode (String.toInt errorCode |> Maybe.withDefault 500) + |> BackendTask.succeed ) |> ApiRoute.literal "error-code" |> ApiRoute.slash @@ -85,16 +81,20 @@ xmlDecoder = Xml.Decode.path [ "path", "to", "string", "value" ] (Xml.Decode.single Xml.Decode.string) in ApiRoute.succeed - (Request.map2 - (\_ xmlString -> - xmlString - |> Xml.Decode.run dataDecoder - |> Result.Extra.merge - |> Response.plainText - |> BackendTask.succeed - ) - (Request.expectContentType "application/xml") - Request.expectBody + (\request -> + --(\_ xmlString -> + case ( request |> Request.matchesContentType "application/xml", Request.body request ) of + ( True, Just xmlString ) -> + xmlString + |> Xml.Decode.run dataDecoder + |> Result.Extra.merge + |> Response.plainText + |> BackendTask.succeed + + _ -> + Response.plainText "Invalid request, expected a body with content-type application/xml." + |> Response.withStatusCode 400 + |> BackendTask.succeed ) |> ApiRoute.literal "api" |> ApiRoute.slash @@ -110,25 +110,28 @@ multipleContentTypes = Xml.Decode.path [ "path", "to", "string", "value" ] (Xml.Decode.single Xml.Decode.string) in ApiRoute.succeed - (Request.oneOf - [ Request.map2 - (\_ xmlString -> + (\request -> + case ( request |> Request.body, request |> Request.matchesContentType "application/xml" ) of + ( Just xmlString, True ) -> xmlString |> Xml.Decode.run dataDecoder |> Result.Extra.merge |> Response.plainText |> BackendTask.succeed - ) - (Request.expectContentType "application/xml") - Request.expectBody - , Request.map - (\decodedValue -> - decodedValue - |> Response.plainText - |> BackendTask.succeed - ) - (Request.expectJsonBody (Decode.at [ "path", "to", "string", "value" ] Decode.string)) - ] + + _ -> + case + request + |> Request.jsonBody + (Decode.at [ "path", "to", "string", "value" ] Decode.string) + of + Just (Ok decodedValue) -> + decodedValue + |> Response.plainText + |> BackendTask.succeed + + _ -> + BackendTask.fail (FatalError.fromString "Invalid request body.") ) |> ApiRoute.literal "api" |> ApiRoute.slash @@ -139,30 +142,24 @@ multipleContentTypes = requestPrinter : ApiRoute ApiRoute.Response requestPrinter = ApiRoute.succeed - (Request.map4 - (\rawBody method cookies queryParams -> - Encode.object - [ ( "rawBody" - , Maybe.map Encode.string rawBody - |> Maybe.withDefault Encode.null - ) - , ( "method" - , method |> Request.methodToString |> Encode.string - ) - , ( "cookies" - , cookies |> Encode.dict identity Encode.string - ) - , ( "queryParams" - , queryParams |> Encode.dict identity (Encode.list Encode.string) - ) - ] - |> Response.json - |> BackendTask.succeed - ) - Request.rawBody - Request.method - Request.allCookies - Request.queryParams + (\request -> + Encode.object + [ ( "rawBody" + , Maybe.map Encode.string (Request.body request) + |> Maybe.withDefault Encode.null + ) + , ( "method" + , Request.method request |> Request.methodToString |> Encode.string + ) + , ( "cookies" + , Request.cookies request |> Encode.dict identity Encode.string + ) + , ( "queryParams" + , request |> Request.queryParams |> Encode.dict identity (Encode.list Encode.string) + ) + ] + |> Response.json + |> BackendTask.succeed ) |> ApiRoute.literal "api" |> ApiRoute.slash @@ -187,40 +184,50 @@ viewHtmlResults tests = greet : ApiRoute ApiRoute.Response greet = ApiRoute.succeed - (Request.oneOf - [ Request.formData - (Form.form - (\bar -> - { combine = - Validation.succeed identity - |> Validation.andMap bar - , view = - \_ -> () - } - ) - |> Form.field "first" (Field.text |> Field.required "Required") - |> Form.Handler.init identity - ) - |> Request.map Tuple.second - |> Request.andThen - (\validated -> - validated - |> Form.toResult - |> Result.mapError (\_ -> "") - |> Request.fromResult - ) - , Request.expectJsonBody (Decode.field "first" Decode.string) - , Request.expectQueryParam "first" - , Request.expectMultiPartFormPost - (\{ field, optionalField } -> - field "first" - ) - ] - |> Request.map - (\firstName -> + (\request -> + let + jsonBody : Maybe (Result Decode.Error String) + jsonBody = + request |> Request.jsonBody (Decode.field "first" Decode.string) + + asFormData : Maybe ( Form.ServerResponse String, Form.Validated String String ) + asFormData = + request + |> Request.formData + (Form.form + (\firstName -> + { combine = + Validation.succeed identity + |> Validation.andMap firstName + , view = + \_ -> () + } + ) + |> Form.field "first" (Field.text |> Field.required "Required") + |> Form.Handler.init identity + ) + + firstNameResult : Result String String + firstNameResult = + case ( asFormData, jsonBody ) of + ( Just ( _, Form.Valid name ), _ ) -> + Ok name + + ( _, Just (Ok name) ) -> + Ok name + + _ -> + Err "" + in + case firstNameResult of + Ok firstName -> Response.plainText ("Hello " ++ firstName) |> BackendTask.succeed - ) + + Err _ -> + Response.plainText "Invalid request, expected either a JSON body or a 'first=' query param." + |> Response.withStatusCode 400 + |> BackendTask.succeed ) |> ApiRoute.literal "api" |> ApiRoute.slash diff --git a/examples/end-to-end/app/Route/CookieTest.elm b/examples/end-to-end/app/Route/CookieTest.elm index 1b8d6c0c5..fe50f6d20 100644 --- a/examples/end-to-end/app/Route/CookieTest.elm +++ b/examples/end-to-end/app/Route/CookieTest.elm @@ -5,10 +5,9 @@ import ErrorPage exposing (ErrorPage) import FatalError exposing (FatalError) import Head import Html.Styled exposing (text) -import Pages.PageUrl exposing (PageUrl) import PagesMsg exposing (PagesMsg) import RouteBuilder exposing (App, StatefulRoute, StatelessRoute) -import Server.Request as Request exposing (Parser) +import Server.Request as Request exposing (Request) import Server.Response as Response exposing (Response) import Shared import View exposing (View) @@ -35,7 +34,7 @@ route = RouteBuilder.serverRender { head = head , data = data - , action = \_ -> Request.skip "No action." + , action = \_ _ -> "No action." |> FatalError.fromString |> BackendTask.fail } |> RouteBuilder.buildNoState { view = view } @@ -44,17 +43,11 @@ type alias Data = { darkMode : Maybe String } -data : RouteParams -> Parser (BackendTask FatalError (Response Data ErrorPage)) -data routeParams = - Request.oneOf - [ Request.expectCookie "dark-mode" - |> Request.map - (\darkMode -> - BackendTask.succeed (Response.render { darkMode = Just darkMode }) - ) - , Request.succeed - (BackendTask.succeed (Response.render { darkMode = Nothing })) - ] +data : RouteParams -> Request -> BackendTask FatalError (Response Data ErrorPage) +data routeParams request = + { darkMode = request |> Request.cookie "dark-mode" } + |> Response.render + |> BackendTask.succeed head : diff --git a/examples/end-to-end/app/Route/DarkMode.elm b/examples/end-to-end/app/Route/DarkMode.elm index 97fbd4013..bb4c04e55 100644 --- a/examples/end-to-end/app/Route/DarkMode.elm +++ b/examples/end-to-end/app/Route/DarkMode.elm @@ -18,7 +18,7 @@ import Pages.Form import PagesMsg exposing (PagesMsg) import Platform.Sub import RouteBuilder -import Server.Request +import Server.Request exposing (Request) import Server.Response import Server.Session as Session import Shared @@ -96,66 +96,69 @@ sessionOptions = data : RouteParams - -> Server.Request.Parser (BackendTask FatalError (Server.Response.Response Data ErrorPage.ErrorPage)) + -> Request + -> BackendTask FatalError (Server.Response.Response Data ErrorPage.ErrorPage) data routeParams = - Server.Request.succeed () - |> Session.withSessionResult sessionOptions - (\() sessionResult -> - let - session : Session.Session - session = - sessionResult - |> Result.withDefault Session.empty - - isDarkMode : Bool - isDarkMode = - (session |> Session.get "darkMode") == Just "dark" - in - BackendTask.succeed - ( session - , Server.Response.render - { isDarkMode = isDarkMode - } - ) - ) + Session.withSessionResult sessionOptions + (\sessionResult -> + let + session : Session.Session + session = + sessionResult + |> Result.withDefault Session.empty + + isDarkMode : Bool + isDarkMode = + (session |> Session.get "darkMode") == Just "dark" + in + BackendTask.succeed + ( session + , Server.Response.render + { isDarkMode = isDarkMode + } + ) + ) action : RouteParams - -> Server.Request.Parser (BackendTask FatalError (Server.Response.Response ActionData ErrorPage.ErrorPage)) -action routeParams = - Server.Request.formData - (form - |> Form.Handler.init identity - ) + -> Request + -> BackendTask FatalError (Server.Response.Response ActionData ErrorPage.ErrorPage) +action routeParams request = + request |> Session.withSessionResult sessionOptions - (\( response, formPost ) sessionResult -> - let - setToDarkMode : Bool - setToDarkMode = - case formPost of - Form.Valid ok -> - ok - - Form.Invalid _ _ -> - False - - session : Session.Session - session = - sessionResult - |> Result.withDefault Session.empty - in - BackendTask.succeed - ( session - |> Session.insert "darkMode" - (if setToDarkMode then - "dark" - - else - "" + (\sessionResult -> + case request |> Server.Request.formData (form |> Form.Handler.init identity) of + Nothing -> + "Expected form submission." |> FatalError.fromString |> BackendTask.fail + + Just ( response, formPost ) -> + let + setToDarkMode : Bool + setToDarkMode = + case formPost of + Form.Valid ok -> + ok + + Form.Invalid _ _ -> + False + + session : Session.Session + session = + sessionResult + |> Result.withDefault Session.empty + in + BackendTask.succeed + ( session + |> Session.insert "darkMode" + (if setToDarkMode then + "dark" + + else + "" + ) + , Server.Response.render (ActionData response) ) - , Server.Response.render (ActionData response) - ) ) diff --git a/examples/end-to-end/app/Route/ErrorHandling.elm b/examples/end-to-end/app/Route/ErrorHandling.elm index f83c5a48e..9a17809f1 100644 --- a/examples/end-to-end/app/Route/ErrorHandling.elm +++ b/examples/end-to-end/app/Route/ErrorHandling.elm @@ -8,7 +8,7 @@ import Html.Styled exposing (text) import Pages.PageUrl exposing (PageUrl) import PagesMsg exposing (PagesMsg) import RouteBuilder exposing (App, StatefulRoute, StatelessRoute) -import Server.Request as Request exposing (Parser) +import Server.Request as Request exposing (Parser, Request) import Server.Response as Response exposing (Response) import Shared import View exposing (View) @@ -35,7 +35,7 @@ route = RouteBuilder.serverRender { head = head , data = data - , action = \_ -> Request.skip "No action." + , action = \_ _ -> Response.render {} |> BackendTask.succeed } |> RouteBuilder.buildNoState { view = view } @@ -44,12 +44,10 @@ type alias Data = { darkMode : Maybe String } -data : RouteParams -> Parser (BackendTask FatalError (Response Data ErrorPage)) -data routeParams = - Request.succeed - (BackendTask.fail - (FatalError.fromString "This error should be displayed by the error handling!") - ) +data : RouteParams -> Request -> BackendTask FatalError (Response Data ErrorPage) +data routeParams request = + BackendTask.fail + (FatalError.fromString "This error should be displayed by the error handling!") head : diff --git a/examples/end-to-end/app/Route/Fetcher.elm b/examples/end-to-end/app/Route/Fetcher.elm index be89fced1..f00c6c848 100644 --- a/examples/end-to-end/app/Route/Fetcher.elm +++ b/examples/end-to-end/app/Route/Fetcher.elm @@ -22,7 +22,7 @@ import Pages.Form import PagesMsg exposing (PagesMsg) import Platform.Sub import RouteBuilder -import Server.Request +import Server.Request exposing (Request) import Server.Response import Shared import View @@ -94,20 +94,19 @@ type alias ActionData = data : RouteParams - -> Server.Request.Parser (BackendTask FatalError (Server.Response.Response Data ErrorPage.ErrorPage)) -data routeParams = - Server.Request.succeed - (BackendTask.Custom.run "getItems" - Encode.null - (Decode.list Decode.string) - |> BackendTask.allowFatal - |> BackendTask.map - (\items -> - Server.Response.render - { items = items - } - ) - ) + -> Request + -> BackendTask FatalError (Server.Response.Response Data ErrorPage.ErrorPage) +data routeParams request = + BackendTask.Custom.run "getItems" + Encode.null + (Decode.list Decode.string) + |> BackendTask.allowFatal + |> BackendTask.map + (\items -> + Server.Response.render + { items = items + } + ) type Action @@ -117,37 +116,38 @@ type Action action : RouteParams - -> Server.Request.Parser (BackendTask FatalError (Server.Response.Response ActionData ErrorPage.ErrorPage)) -action routeParams = - Server.Request.formData - forms - |> Server.Request.map - (\( formResponse, formPost ) -> - case formPost of - Form.Valid (AddItem newItem) -> - BackendTask.Custom.run "addItem" - (Encode.string newItem) - (Decode.list Decode.string) - |> BackendTask.allowFatal - |> BackendTask.map - (\_ -> - Server.Response.render ActionData - ) - - Form.Valid DeleteAll -> - BackendTask.Custom.run "deleteAllItems" - Encode.null - (Decode.list Decode.string) - |> BackendTask.allowFatal - |> BackendTask.map - (\_ -> - Server.Response.render ActionData - ) - - Form.Invalid _ _ -> - BackendTask.succeed - (Server.Response.render ActionData) - ) + -> Request + -> BackendTask FatalError (Server.Response.Response ActionData ErrorPage.ErrorPage) +action routeParams request = + case request |> Server.Request.formData forms of + Nothing -> + Debug.todo "TODO" + + Just ( formResponse, formPost ) -> + case formPost of + Form.Valid (AddItem newItem) -> + BackendTask.Custom.run "addItem" + (Encode.string newItem) + (Decode.list Decode.string) + |> BackendTask.allowFatal + |> BackendTask.map + (\_ -> + Server.Response.render ActionData + ) + + Form.Valid DeleteAll -> + BackendTask.Custom.run "deleteAllItems" + Encode.null + (Decode.list Decode.string) + |> BackendTask.allowFatal + |> BackendTask.map + (\_ -> + Server.Response.render ActionData + ) + + Form.Invalid _ _ -> + BackendTask.succeed + (Server.Response.render ActionData) forms : Form.Handler.Handler String Action diff --git a/examples/end-to-end/app/Route/Form.elm b/examples/end-to-end/app/Route/Form.elm index 2e142e8b3..862fd5ef3 100644 --- a/examples/end-to-end/app/Route/Form.elm +++ b/examples/end-to-end/app/Route/Form.elm @@ -16,7 +16,7 @@ import Html.Styled import Pages.Form import PagesMsg exposing (PagesMsg) import RouteBuilder exposing (App, StatelessRoute) -import Server.Request as Request exposing (Parser) +import Server.Request as Request exposing (Request) import Server.Response import Shared import Time @@ -184,30 +184,30 @@ type alias Data = {} -data : RouteParams -> Parser (BackendTask FatalError (Server.Response.Response Data ErrorPage)) -data routeParams = +data : RouteParams -> Request -> BackendTask FatalError (Server.Response.Response Data ErrorPage) +data routeParams request = Data |> Server.Response.render |> BackendTask.succeed - |> Request.succeed - - -action : RouteParams -> Parser (BackendTask FatalError (Server.Response.Response ActionData ErrorPage)) -action routeParams = - Request.formData (form |> Form.Handler.init identity) - |> Request.map - (\( formResponse, userResult ) -> - ActionData - (userResult - |> Form.toResult - -- TODO nicer error handling - -- TODO wire up BackendTask server-side validation errors - |> Result.withDefault defaultUser - ) - formResponse - |> Server.Response.render - |> BackendTask.succeed - ) + + +action : RouteParams -> Request -> BackendTask FatalError (Server.Response.Response ActionData ErrorPage) +action routeParams request = + case request |> Request.formData (form |> Form.Handler.init identity) of + Nothing -> + "Expected form submission." |> FatalError.fromString |> BackendTask.fail + + Just ( formResponse, userResult ) -> + ActionData + (userResult + |> Form.toResult + -- TODO nicer error handling + -- TODO wire up BackendTask server-side validation errors + |> Result.withDefault defaultUser + ) + formResponse + |> Server.Response.render + |> BackendTask.succeed head : diff --git a/examples/end-to-end/app/Route/GetForm.elm b/examples/end-to-end/app/Route/GetForm.elm index 4638f4012..060b1d6f8 100644 --- a/examples/end-to-end/app/Route/GetForm.elm +++ b/examples/end-to-end/app/Route/GetForm.elm @@ -15,7 +15,7 @@ import Html.Styled import Pages.Form import PagesMsg exposing (PagesMsg) import RouteBuilder exposing (App, StatelessRoute) -import Server.Request as Request exposing (Parser) +import Server.Request as Request exposing (Request) import Server.Response import Shared import View exposing (View) @@ -84,30 +84,31 @@ type alias Data = } -data : RouteParams -> Parser (BackendTask FatalError (Server.Response.Response Data ErrorPage)) -data routeParams = - Request.formData (Form.Handler.init identity form) - |> Request.map - (\( formResponse, formResult ) -> - case formResult of - Form.Valid filters -> - Data filters - |> Server.Response.render - |> BackendTask.succeed - - Form.Invalid _ _ -> - Data { page = 1 } - |> Server.Response.render - |> BackendTask.succeed - ) +data : RouteParams -> Request -> BackendTask FatalError (Server.Response.Response Data ErrorPage) +data routeParams request = + case request |> Request.formData (Form.Handler.init identity form) of + Nothing -> + Data { page = 1 } + |> Server.Response.render + |> BackendTask.succeed + Just ( formResponse, formResult ) -> + case formResult of + Form.Valid filters -> + Data filters + |> Server.Response.render + |> BackendTask.succeed -action : RouteParams -> Parser (BackendTask FatalError (Server.Response.Response ActionData ErrorPage)) -action routeParams = - Request.succeed - (Server.Response.render {} - |> BackendTask.succeed - ) + Form.Invalid _ _ -> + Data { page = 1 } + |> Server.Response.render + |> BackendTask.succeed + + +action : RouteParams -> Request -> BackendTask FatalError (Server.Response.Response ActionData ErrorPage) +action routeParams request = + Server.Response.render {} + |> BackendTask.succeed head : diff --git a/examples/end-to-end/app/Route/Greet.elm b/examples/end-to-end/app/Route/Greet.elm index 1c55b5d1a..b0b3d126c 100644 --- a/examples/end-to-end/app/Route/Greet.elm +++ b/examples/end-to-end/app/Route/Greet.elm @@ -13,7 +13,7 @@ import Pages.PageUrl exposing (PageUrl) import Pages.Url import PagesMsg exposing (PagesMsg) import RouteBuilder exposing (App, StatefulRoute, StatelessRoute) -import Server.Request as Request +import Server.Request as Request exposing (Request) import Server.Response as Response exposing (Response) import Server.Session as Session import Shared @@ -42,7 +42,7 @@ route = RouteBuilder.serverRender { head = head , data = data - , action = \_ -> Request.skip "" + , action = \_ _ -> BackendTask.succeed (Response.render {}) } |> RouteBuilder.buildWithLocalState { view = view @@ -79,49 +79,48 @@ type alias Data = } -data : RouteParams -> Request.Parser (BackendTask FatalError (Response Data ErrorPage)) -data routeParams = - Request.oneOf - [ Request.map2 (\a b -> Data a b Nothing) - (Request.expectQueryParam "name") - Request.requestTime - |> Request.map - (\requestData -> - requestData - |> Response.render - |> Response.withHeader - "x-greeting" - ("hello there " ++ requestData.username ++ "!") - |> BackendTask.succeed - ) - , Request.requestTime - |> MySession.expectSessionOrRedirect - (\requestTime session -> - let - username : String - username = - session - |> Session.get "name" - |> Maybe.withDefault "NONAME" - - flashMessage : Maybe String - flashMessage = - session - |> Session.get "message" - in - ( session - , { username = username - , requestTime = requestTime - , flashMessage = flashMessage - } - |> Response.render - |> Response.withHeader - "x-greeting" - ("hello " ++ username ++ "!") +data : RouteParams -> Request -> BackendTask FatalError (Response Data ErrorPage) +data routeParams request = + case request |> Request.queryParam "name" of + Just name -> + Data name (Request.requestTime request) Nothing + |> Response.render + |> Response.withHeader + "x-greeting" + ("hello there " ++ name ++ "!") + |> BackendTask.succeed + + Nothing -> + request + |> MySession.expectSessionOrRedirect + (\session -> + let + requestTime = + request |> Request.requestTime + + username : String + username = + session + |> Session.get "name" + |> Maybe.withDefault "NONAME" + + flashMessage : Maybe String + flashMessage = + session + |> Session.get "message" + in + ( session + , { username = username + , requestTime = requestTime + , flashMessage = flashMessage + } + |> Response.render + |> Response.withHeader + "x-greeting" + ("hello " ++ username ++ "!") + ) + |> BackendTask.succeed ) - |> BackendTask.succeed - ) - ] head : diff --git a/examples/end-to-end/app/Route/Hello.elm b/examples/end-to-end/app/Route/Hello.elm index db0f51dea..c4c2a245d 100644 --- a/examples/end-to-end/app/Route/Hello.elm +++ b/examples/end-to-end/app/Route/Hello.elm @@ -8,7 +8,7 @@ import Head.Seo as Seo import Pages.Url import PagesMsg exposing (PagesMsg) import RouteBuilder exposing (App, StatefulRoute, StatelessRoute) -import Server.Request as Request +import Server.Request as Request exposing (Request) import Server.Response as Response exposing (Response) import Shared import View exposing (View) @@ -35,7 +35,7 @@ route = RouteBuilder.serverRender { head = head , data = data - , action = \_ -> Request.skip "" + , action = \_ _ -> BackendTask.succeed (Response.render {}) } |> RouteBuilder.buildNoState { view = view } @@ -44,9 +44,9 @@ type alias Data = {} -data : RouteParams -> Request.Parser (BackendTask FatalError (Response Data ErrorPage)) -data routeParams = - Request.succeed (BackendTask.succeed (Response.render Data)) +data : RouteParams -> Request -> BackendTask FatalError (Response Data ErrorPage) +data routeParams request = + BackendTask.succeed (Response.render Data) head : diff --git a/examples/end-to-end/app/Route/Login.elm b/examples/end-to-end/app/Route/Login.elm index a033ed7b8..b8fe0c49d 100644 --- a/examples/end-to-end/app/Route/Login.elm +++ b/examples/end-to-end/app/Route/Login.elm @@ -16,7 +16,7 @@ import Pages.Form import PagesMsg exposing (PagesMsg) import Route import RouteBuilder exposing (App, StatefulRoute, StatelessRoute) -import Server.Request as Request +import Server.Request as Request exposing (Request) import Server.Response as Response exposing (Response) import Server.Session as Session import Shared @@ -50,31 +50,36 @@ route = |> RouteBuilder.buildNoState { view = view } -action : RouteParams -> Request.Parser (BackendTask FatalError (Response ActionData ErrorPage)) -action routeParams = - Request.formDataWithServerValidation (form |> Form.Handler.init identity) +action : RouteParams -> Request -> BackendTask FatalError (Response ActionData ErrorPage) +action routeParams request = + request |> MySession.withSession - (\nameResultData session -> - nameResultData - |> BackendTask.map - (\nameResult -> - case nameResult of - Err errors -> - ( session - |> Result.withDefault Session.empty - , Response.render - { errors = errors - } - ) - - Ok ( _, name ) -> - ( session - |> Result.withDefault Session.empty - |> Session.insert "name" name - |> Session.withFlash "message" ("Welcome " ++ name ++ "!") - , Route.redirectTo Route.Greet - ) - ) + (\session -> + case request |> Request.formDataWithServerValidation (form |> Form.Handler.init identity) of + Nothing -> + BackendTask.fail (FatalError.fromString "Invalid form response") + + Just nameResultData -> + nameResultData + |> BackendTask.map + (\nameResult -> + case nameResult of + Err errors -> + ( session + |> Result.withDefault Session.empty + , Response.render + { errors = errors + } + ) + + Ok ( _, name ) -> + ( session + |> Result.withDefault Session.empty + |> Session.insert "name" name + |> Session.withFlash "message" ("Welcome " ++ name ++ "!") + , Route.redirectTo Route.Greet + ) + ) ) @@ -160,36 +165,34 @@ form = |> Form.field "name" (Field.text |> Field.required "Required") -data : RouteParams -> Request.Parser (BackendTask FatalError (Response Data ErrorPage)) -data routeParams = - Request.oneOf - [ Request.succeed () - |> MySession.withSession - (\() session -> - case session of - Ok okSession -> - let - flashMessage : Maybe String - flashMessage = - okSession - |> Session.get "message" - in - ( okSession - , Data - (okSession |> Session.get "name") - flashMessage - |> Response.render - ) - |> BackendTask.succeed - - _ -> - ( Session.empty - , { username = Nothing, flashMessage = Nothing } - |> Response.render - ) - |> BackendTask.succeed - ) - ] +data : RouteParams -> Request -> BackendTask FatalError (Response Data ErrorPage) +data routeParams request = + request + |> MySession.withSession + (\session -> + case session of + Ok okSession -> + let + flashMessage : Maybe String + flashMessage = + okSession + |> Session.get "message" + in + ( okSession + , Data + (okSession |> Session.get "name") + flashMessage + |> Response.render + ) + |> BackendTask.succeed + + _ -> + ( Session.empty + , { username = Nothing, flashMessage = Nothing } + |> Response.render + ) + |> BackendTask.succeed + ) head : diff --git a/examples/end-to-end/app/Route/Logout.elm b/examples/end-to-end/app/Route/Logout.elm index 8df5a10b8..3d1c8aaaf 100644 --- a/examples/end-to-end/app/Route/Logout.elm +++ b/examples/end-to-end/app/Route/Logout.elm @@ -10,7 +10,7 @@ import Pages.Url import PagesMsg exposing (PagesMsg) import Route import RouteBuilder exposing (App, StatefulRoute, StatelessRoute) -import Server.Request as Request +import Server.Request as Request exposing (Request) import Server.Response as Response exposing (Response) import Server.Session as Session import Shared @@ -43,11 +43,11 @@ route = |> RouteBuilder.buildNoState { view = view } -action : RouteParams -> Request.Parser (BackendTask FatalError (Response ActionData ErrorPage)) -action _ = - Request.succeed () +action : RouteParams -> Request -> BackendTask FatalError (Response ActionData ErrorPage) +action _ request = + request |> MySession.withSession - (\_ _ -> + (\_ -> ( Session.empty |> Session.withFlash "message" "You have been successfully logged out." , Route.redirectTo Route.Login @@ -60,9 +60,9 @@ type alias Data = {} -data : RouteParams -> Request.Parser (BackendTask FatalError (Response Data ErrorPage)) -data routeParams = - Request.succeed (BackendTask.succeed (Response.render {})) +data : RouteParams -> Request -> BackendTask FatalError (Response Data ErrorPage) +data routeParams request = + BackendTask.succeed (Response.render {}) head : diff --git a/examples/end-to-end/app/Route/Redirect.elm b/examples/end-to-end/app/Route/Redirect.elm deleted file mode 100644 index 207a6b3b6..000000000 --- a/examples/end-to-end/app/Route/Redirect.elm +++ /dev/null @@ -1,128 +0,0 @@ -module Route.Redirect exposing (ActionData, Data, Model, Msg, route) - -import BackendTask exposing (BackendTask) -import Effect exposing (Effect) -import ErrorPage exposing (ErrorPage) -import FatalError exposing (FatalError) -import Head -import Head.Seo as Seo -import Pages.Url -import PagesMsg exposing (PagesMsg) -import Route -import RouteBuilder exposing (App, StatefulRoute, StatelessRoute) -import Server.Request as Request -import Server.Response as Response exposing (Response) -import Shared -import UrlPath exposing (UrlPath) -import View exposing (View) - - -type alias Model = - {} - - -type Msg - = NoOp - - -type alias RouteParams = - {} - - -type alias ActionData = - {} - - -route : StatefulRoute RouteParams Data ActionData Model Msg -route = - RouteBuilder.serverRender - { head = head - , data = data - , action = \_ -> Request.skip "No action." - } - |> RouteBuilder.buildWithLocalState - { view = view - , update = update - , subscriptions = subscriptions - , init = init - } - - -init : - App Data ActionData RouteParams - -> Shared.Model - -> ( Model, Effect Msg ) -init app shared = - ( {} - , -- TODO - --Effect.FetchRouteData - -- { data = - -- Just - -- { fields = [] - -- , action = "/redirect" - -- , method = Post - -- , id = Nothing - -- } - -- , toMsg = \_ -> NoOp - -- } - Effect.none - ) - - -update : - App Data ActionData RouteParams - -> Shared.Model - -> Msg - -> Model - -> ( Model, Effect Msg ) -update app shared msg model = - case msg of - NoOp -> - ( model, Effect.none ) - - -subscriptions : RouteParams -> UrlPath -> Shared.Model -> Model -> Sub Msg -subscriptions routeParams path sharedModel model = - Sub.none - - -type alias Data = - {} - - -data : RouteParams -> Request.Parser (BackendTask FatalError (Response Data ErrorPage)) -data routeParams = - Request.oneOf - [ Request.acceptMethod ( Request.Post, [] ) - (Request.succeed (BackendTask.succeed (Route.redirectTo Route.Hello))) - , Request.succeed (BackendTask.succeed (Response.render Data)) - ] - - -head : - App Data ActionData RouteParams - -> List Head.Tag -head app = - Seo.summary - { canonicalUrlOverride = Nothing - , siteName = "elm-pages" - , image = - { url = Pages.Url.external "TODO" - , alt = "elm-pages logo" - , dimensions = Nothing - , mimeType = Nothing - } - , description = "TODO" - , locale = Nothing - , title = "TODO title" -- metadata.title -- TODO - } - |> Seo.website - - -view : - App Data ActionData RouteParams - -> Shared.Model - -> Model - -> View (PagesMsg Msg) -view app shared model = - View.placeholder "Redirect" diff --git a/examples/end-to-end/app/Route/Test/BasicAuth.elm b/examples/end-to-end/app/Route/Test/BasicAuth.elm index 8664f10c5..4f0c85d11 100644 --- a/examples/end-to-end/app/Route/Test/BasicAuth.elm +++ b/examples/end-to-end/app/Route/Test/BasicAuth.elm @@ -9,7 +9,7 @@ import Html.Styled exposing (div, text) import Pages.PageUrl exposing (PageUrl) import PagesMsg exposing (PagesMsg) import RouteBuilder exposing (App, StatefulRoute, StatelessRoute) -import Server.Request as Request exposing (Parser) +import Server.Request as Request exposing (Parser, Request) import Server.Response as Response exposing (Response) import Shared import View exposing (View) @@ -36,7 +36,7 @@ route = RouteBuilder.serverRender { head = head , data = data - , action = \_ -> Request.skip "No action." + , action = \_ _ -> BackendTask.succeed (Response.render {}) } |> RouteBuilder.buildNoState { view = view } @@ -46,17 +46,18 @@ type alias Data = } -data : RouteParams -> Parser (BackendTask FatalError (Response Data ErrorPage)) -data routeParams = - withBasicAuth - (\{ username, password } -> - (username == "asdf" && password == "qwer") +data : RouteParams -> Request -> BackendTask FatalError (Response Data ErrorPage) +data routeParams request = + request + |> withBasicAuth + (\{ username, password } -> + (username == "asdf" && password == "qwer") + |> BackendTask.succeed + ) + (Data "Login success!" + |> Response.render |> BackendTask.succeed - ) - (Data "Login success!" - |> Response.render - |> BackendTask.succeed - ) + ) head : @@ -102,27 +103,24 @@ parseAuth base64Auth = withBasicAuth : ({ username : String, password : String } -> BackendTask error Bool) -> BackendTask error (Response data errorPage) - -> Parser (BackendTask error (Response data errorPage)) -withBasicAuth checkAuth successResponse = - Request.optionalHeader "authorization" - |> Request.map - (\base64Auth -> - case base64Auth |> Maybe.andThen parseAuth of - Just userPass -> - checkAuth userPass - |> BackendTask.andThen - (\authSucceeded -> - if authSucceeded then - successResponse - - else - requireBasicAuth |> BackendTask.succeed - ) - - Nothing -> - requireBasicAuth - |> BackendTask.succeed - ) + -> Request + -> BackendTask error (Response data errorPage) +withBasicAuth checkAuth successResponse request = + case request |> Request.header "authorization" |> Maybe.andThen parseAuth of + Just userPass -> + checkAuth userPass + |> BackendTask.andThen + (\authSucceeded -> + if authSucceeded then + successResponse + + else + requireBasicAuth |> BackendTask.succeed + ) + + Nothing -> + requireBasicAuth + |> BackendTask.succeed requireBasicAuth : Response data errorPage diff --git a/examples/end-to-end/app/Route/Test/ResponseHeaders.elm b/examples/end-to-end/app/Route/Test/ResponseHeaders.elm index 7f3c6699d..2ab06f76c 100644 --- a/examples/end-to-end/app/Route/Test/ResponseHeaders.elm +++ b/examples/end-to-end/app/Route/Test/ResponseHeaders.elm @@ -10,7 +10,7 @@ import Html.Styled exposing (div, text) import Pages.PageUrl exposing (PageUrl) import PagesMsg exposing (PagesMsg) import RouteBuilder exposing (App, StatefulRoute, StatelessRoute) -import Server.Request as Request exposing (Parser) +import Server.Request as Request exposing (Parser, Request) import Server.Response as Response exposing (Response) import Shared import View exposing (View) @@ -37,7 +37,7 @@ route = RouteBuilder.serverRender { head = head , data = data - , action = \_ -> Request.skip "" + , action = \_ _ -> "No actions" |> FatalError.fromString |> BackendTask.fail } |> RouteBuilder.buildNoState { view = view } @@ -47,14 +47,12 @@ type alias Data = } -data : RouteParams -> Parser (BackendTask FatalError (Response Data ErrorPage)) -data routeParams = - Request.succeed - (BackendTask.succeed Data - |> BackendTask.andMap (BackendTask.File.rawFile "greeting.txt" |> BackendTask.allowFatal) - |> BackendTask.map Response.render - |> BackendTask.map (Response.withHeader "x-powered-by" "my-framework") - ) +data : RouteParams -> Request -> BackendTask FatalError (Response Data ErrorPage) +data routeParams request = + BackendTask.succeed Data + |> BackendTask.andMap (BackendTask.File.rawFile "greeting.txt" |> BackendTask.allowFatal) + |> BackendTask.map Response.render + |> BackendTask.map (Response.withHeader "x-powered-by" "my-framework") diff --git a/examples/end-to-end/cypress/e2e/api-routes.cy.ts b/examples/end-to-end/cypress/e2e/api-routes.cy.ts index 879a10f72..2e1570127 100644 --- a/examples/end-to-end/cypress/e2e/api-routes.cy.ts +++ b/examples/end-to-end/cypress/e2e/api-routes.cy.ts @@ -52,7 +52,7 @@ it("expect query param when none present", () => { expect(res.headers["content-type"]).to.eq("text/plain"); expect(res.status).to.eq(400); expect(res.body).to.include( - 'Expected query param "first", but there were no query params.' + `Invalid request, expected either a JSON body or a 'first=' query param.` ); }); }); @@ -65,7 +65,9 @@ it("missing expected query param", () => { }).then((res) => { expect(res.headers["content-type"]).to.eq("text/plain"); expect(res.status).to.eq(400); - expect(res.body).to.include('Missing query param "first"'); + expect(res.body).to.include( + `Invalid request, expected either a JSON body or a 'first=' query param.` + ); }); }); @@ -152,7 +154,7 @@ it("gives an error when there is no content-type header", () => { expect(res.headers["content-type"]).to.eq("text/plain"); expect(res.status).to.eq(400); expect(res.body).to.eq( - "Expected content-type `application/xml` but there was no content-type header." + "Invalid request, expected a body with content-type application/xml." ); }); }); diff --git a/examples/end-to-end/src/MySession.elm b/examples/end-to-end/src/MySession.elm index 08f31bbb7..f16ef5839 100644 --- a/examples/end-to-end/src/MySession.elm +++ b/examples/end-to-end/src/MySession.elm @@ -5,15 +5,15 @@ import BackendTask.Env as Env import Codec import FatalError exposing (FatalError) import Route -import Server.Request exposing (Parser) +import Server.Request exposing (Request) import Server.Response exposing (Response) import Server.Session as Session withSession : - (request -> Result Session.NotLoadedReason Session.Session -> BackendTask FatalError ( Session.Session, Response data errorPage )) - -> Parser request - -> Parser (BackendTask FatalError (Response data errorPage)) + (Result Session.NotLoadedReason Session.Session -> BackendTask FatalError ( Session.Session, Response data errorPage )) + -> Request + -> BackendTask FatalError (Response data errorPage) withSession = Session.withSessionResult { name = "mysession" @@ -23,18 +23,18 @@ withSession = withSessionOrRedirect : - (request -> Session.Session -> BackendTask FatalError ( Session.Session, Response data errorPage )) - -> Parser request - -> Parser (BackendTask FatalError (Response data errorPage)) + (Session.Session -> BackendTask FatalError ( Session.Session, Response data errorPage )) + -> Request + -> BackendTask FatalError (Response data errorPage) withSessionOrRedirect toRequest handler = Session.withSessionResult { name = "mysession" , secrets = secrets , options = Nothing } - (\request sessionResult -> + (\sessionResult -> sessionResult - |> Result.map (toRequest request) + |> Result.map toRequest |> Result.withDefault (BackendTask.succeed ( Session.empty @@ -53,18 +53,18 @@ secrets = expectSessionOrRedirect : - (request -> Session.Session -> BackendTask FatalError ( Session.Session, Response data errorPage )) - -> Parser request - -> Parser (BackendTask FatalError (Response data errorPage)) -expectSessionOrRedirect toRequest handler = + (Session.Session -> BackendTask FatalError ( Session.Session, Response data errorPage )) + -> Request + -> BackendTask FatalError (Response data errorPage) +expectSessionOrRedirect toRequest request = Session.withSessionResult { name = "mysession" , secrets = secrets , options = Nothing } - (\request sessionResult -> + (\sessionResult -> sessionResult - |> Result.map (toRequest request) + |> Result.map toRequest |> Result.withDefault (BackendTask.succeed ( Session.empty @@ -72,7 +72,7 @@ expectSessionOrRedirect toRequest handler = ) ) ) - handler + request schema = diff --git a/generator/src/RouteBuilder.elm b/generator/src/RouteBuilder.elm index fc783bcb8..7aea29f6b 100644 --- a/generator/src/RouteBuilder.elm +++ b/generator/src/RouteBuilder.elm @@ -98,20 +98,20 @@ import Pages.ConcurrentSubmission import Pages.Fetcher import Pages.Internal.NotFoundReason exposing (NotFoundReason) import Pages.Internal.RoutePattern exposing (RoutePattern) -import Pages.PageUrl exposing (PageUrl) import Pages.Navigation +import Pages.PageUrl exposing (PageUrl) import PagesMsg exposing (PagesMsg) -import UrlPath exposing (UrlPath) import Server.Request import Server.Response import Shared +import UrlPath exposing (UrlPath) import View exposing (View) {-| -} type alias StatefulRoute routeParams data action model msg = - { data : Json.Decode.Value -> routeParams -> BackendTask FatalError (Server.Response.Response data ErrorPage) - , action : Json.Decode.Value -> routeParams -> BackendTask FatalError (Server.Response.Response action ErrorPage) + { data : Server.Request.Request -> routeParams -> BackendTask FatalError (Server.Response.Response data ErrorPage) + , action : Server.Request.Request -> routeParams -> BackendTask FatalError (Server.Response.Response action ErrorPage) , staticRoutes : BackendTask FatalError (List routeParams) , view : Shared.Model @@ -155,8 +155,8 @@ type alias App data action routeParams = {-| -} type Builder routeParams data action = WithData - { data : Json.Decode.Value -> routeParams -> BackendTask FatalError (Server.Response.Response data ErrorPage) - , action : Json.Decode.Value -> routeParams -> BackendTask FatalError (Server.Response.Response action ErrorPage) + { data : Server.Request.Request -> routeParams -> BackendTask FatalError (Server.Response.Response data ErrorPage) + , action : Server.Request.Request -> routeParams -> BackendTask FatalError (Server.Response.Response action ErrorPage) , staticRoutes : BackendTask FatalError (List routeParams) , head : App data action routeParams @@ -362,61 +362,19 @@ preRenderWithFallback { data, head, pages } = {-| -} serverRender : - { data : routeParams -> Server.Request.Parser (BackendTask FatalError (Server.Response.Response data ErrorPage)) - , action : routeParams -> Server.Request.Parser (BackendTask FatalError (Server.Response.Response action ErrorPage)) + { data : routeParams -> Server.Request.Request -> BackendTask FatalError (Server.Response.Response data ErrorPage) + , action : routeParams -> Server.Request.Request -> BackendTask FatalError (Server.Response.Response action ErrorPage) , head : App data action routeParams -> List Head.Tag } -> Builder routeParams data action serverRender { data, action, head } = WithData { data = - \requestPayload routeParams -> - (routeParams - |> data - |> Server.Request.getDecoder - |> (\decoder -> - Json.Decode.decodeValue decoder requestPayload - |> Result.mapError Json.Decode.errorToString - |> BackendTask.fromResult - -- TODO include title and better error context and formatting - |> BackendTask.onError (\error -> BackendTask.fail (FatalError.fromString error)) - ) - ) - |> BackendTask.andThen - (\rendered -> - case rendered of - Ok okRendered -> - okRendered - - Err error -> - Server.Request.errorsToString error - |> FatalError.fromString - |> BackendTask.fail - ) + \request routeParams -> + data routeParams request , action = - \requestPayload routeParams -> - (routeParams - |> action - |> Server.Request.getDecoder - |> (\decoder -> - Json.Decode.decodeValue decoder requestPayload - |> Result.mapError Json.Decode.errorToString - |> BackendTask.fromResult - -- TODO include title and better error context and formatting - |> BackendTask.onError (\error -> BackendTask.fail (FatalError.fromString error)) - ) - ) - |> BackendTask.andThen - (\rendered -> - case rendered of - Ok okRendered -> - okRendered - - Err error -> - Server.Request.errorsToString error - |> FatalError.fromString - |> BackendTask.fail - ) + \request routeParams -> + action routeParams request , staticRoutes = BackendTask.succeed [] , head = head , serverless = True diff --git a/src/ApiRoute.elm b/src/ApiRoute.elm index 4d134ebd4..8ab3b80ed 100644 --- a/src/ApiRoute.elm +++ b/src/ApiRoute.elm @@ -176,6 +176,7 @@ import BackendTask exposing (BackendTask) import FatalError exposing (FatalError) import Head import Internal.ApiRoute exposing (ApiRoute(..), ApiRouteBuilder(..)) +import Internal.Request import Json.Decode as Decode import Json.Encode import Pattern @@ -199,7 +200,7 @@ single handler = {-| -} -serverRender : ApiRouteBuilder (Server.Request.Parser (BackendTask FatalError (Server.Response.Response Never Never))) constructor -> ApiRoute Response +serverRender : ApiRouteBuilder (Server.Request.Request -> BackendTask FatalError (Server.Response.Response Never Never)) constructor -> ApiRoute Response serverRender ((ApiRouteBuilder patterns pattern _ _ _) as fullHandler) = ApiRoute { regex = Regex.fromString ("^" ++ pattern ++ "$") |> Maybe.withDefault Regex.never @@ -208,36 +209,7 @@ serverRender ((ApiRouteBuilder patterns pattern _ _ _) as fullHandler) = Internal.ApiRoute.tryMatch path fullHandler |> Maybe.map (\toBackendTask -> - Server.Request.getDecoder toBackendTask - |> (\decoder -> - Decode.decodeValue decoder serverRequest - |> Result.mapError Decode.errorToString - |> BackendTask.fromResult - |> BackendTask.map Just - ) - |> BackendTask.onError - (\stringError -> - -- TODO make error with title and better context/formatting - FatalError.fromString stringError |> BackendTask.fail - ) - |> BackendTask.andThen - (\rendered -> - case rendered of - Just (Ok okRendered) -> - okRendered - - Just (Err errors) -> - errors - |> Server.Request.errorsToString - |> Server.Response.plainText - |> Server.Response.withStatusCode 400 - |> BackendTask.succeed - - Nothing -> - Server.Response.plainText "No matching request handler" - |> Server.Response.withStatusCode 400 - |> BackendTask.succeed - ) + toBackendTask (Internal.Request.toRequest serverRequest) ) |> Maybe.map (BackendTask.map (Server.Response.toJson >> Just)) |> Maybe.withDefault diff --git a/src/FormData.elm b/src/FormData.elm index c0618cc1c..92929fc3d 100644 --- a/src/FormData.elm +++ b/src/FormData.elm @@ -1,4 +1,4 @@ -module FormData exposing (encode, parse) +module FormData exposing (encode, parse, parseToList) import Dict exposing (Dict) import List.NonEmpty exposing (NonEmpty) @@ -34,6 +34,26 @@ parse rawString = Dict.empty +parseToList : String -> List ( String, String ) +parseToList rawString = + rawString + |> String.split "&" + |> List.concatMap + (\entry -> + case entry |> String.split "=" of + [ key, value ] -> + let + newValue : String + newValue = + value |> decode + in + [ ( key, newValue ) ] + + _ -> + [] + ) + + decode : String -> String decode string = string diff --git a/src/Internal/Request.elm b/src/Internal/Request.elm index cbf27e6d1..9caf95121 100644 --- a/src/Internal/Request.elm +++ b/src/Internal/Request.elm @@ -1,7 +1,91 @@ -module Internal.Request exposing (Parser(..)) +module Internal.Request exposing (Parser(..), Request(..), RequestRecord, fakeRequest, toRequest) -import Json.Decode +import CookieParser +import Dict exposing (Dict) +import Json.Decode as Decode +import Time type Parser decodesTo validationError - = Parser (Json.Decode.Decoder ( Result validationError decodesTo, List validationError )) + = Parser (Decode.Decoder ( Result validationError decodesTo, List validationError )) + + +type Request + = Request RequestRecord + + +type alias RequestRecord = + { time : Time.Posix + , method : String + , body : Maybe String + , rawUrl : String + , rawHeaders : Dict String String + , cookies : Dict String String + } + + +toRequest : Decode.Value -> Request +toRequest value = + Decode.decodeValue requestDecoder value + |> Result.map Request + |> Result.withDefault fakeRequest + + +fakeRequest : Request +fakeRequest = + Request + { time = Time.millisToPosix 0 + , method = "ERROR" + , body = Just "ERROR" + , rawUrl = "ERROR" + , rawHeaders = Dict.empty + , cookies = Dict.empty + } + + +requestDecoder : Decode.Decoder RequestRecord +requestDecoder = + Decode.succeed RequestRecord + |> andMap + (Decode.field "requestTime" + (Decode.int |> Decode.map Time.millisToPosix) + ) + |> andMap (Decode.field "method" Decode.string) + |> andMap (Decode.field "body" (Decode.nullable Decode.string)) + |> andMap + (Decode.string + |> Decode.field "rawUrl" + ) + |> andMap (Decode.field "headers" (Decode.dict Decode.string)) + |> andMap + (Decode.field "headers" + (optionalField "cookie" Decode.string + |> Decode.map + (Maybe.map CookieParser.parse + >> Maybe.withDefault Dict.empty + ) + ) + ) + + +andMap : Decode.Decoder a -> Decode.Decoder (a -> b) -> Decode.Decoder b +andMap = + Decode.map2 (|>) + + +optionalField : String -> Decode.Decoder a -> Decode.Decoder (Maybe a) +optionalField fieldName decoder_ = + let + finishDecoding : Decode.Value -> Decode.Decoder (Maybe a) + finishDecoding json = + case Decode.decodeValue (Decode.field fieldName Decode.value) json of + Ok _ -> + -- The field is present, so run the decoder on it. + Decode.map Just (Decode.field fieldName decoder_) + + Err _ -> + -- The field was missing, which is fine! + Decode.succeed Nothing + in + Decode.value + |> Decode.andThen finishDecoding diff --git a/src/Pages/Internal/Platform/Cli.elm b/src/Pages/Internal/Platform/Cli.elm index 48cc71332..8936a0afd 100644 --- a/src/Pages/Internal/Platform/Cli.elm +++ b/src/Pages/Internal/Platform/Cli.elm @@ -17,6 +17,7 @@ import Head exposing (Tag) import Html exposing (Html) import HtmlPrinter import Internal.ApiRoute exposing (ApiRoute(..)) +import Internal.Request import Json.Decode as Decode import Json.Encode import PageServerResponse exposing (PageServerResponse) @@ -422,7 +423,13 @@ initLegacy site ((RenderRequest.SinglePage includeHtml singleRequest _) as rende --sendSinglePageProgress site model.allRawResponses config model payload (case isAction of Just _ -> - config.action (RenderRequest.maybeRequestPayload renderRequest |> Maybe.withDefault Json.Encode.null) serverRequestPayload.frontmatter |> BackendTask.map Just + config.action + (RenderRequest.maybeRequestPayload renderRequest + |> Maybe.map Internal.Request.toRequest + |> Maybe.withDefault Internal.Request.fakeRequest + ) + serverRequestPayload.frontmatter + |> BackendTask.map Just Nothing -> BackendTask.succeed Nothing @@ -674,7 +681,13 @@ initLegacy site ((RenderRequest.SinglePage includeHtml singleRequest _) as rende in renderedResult ) - (config.data (RenderRequest.maybeRequestPayload renderRequest |> Maybe.withDefault Json.Encode.null) serverRequestPayload.frontmatter) + (config.data + (RenderRequest.maybeRequestPayload renderRequest + |> Maybe.map Internal.Request.toRequest + |> Maybe.withDefault Internal.Request.fakeRequest + ) + serverRequestPayload.frontmatter + ) config.sharedData globalHeadTags ) diff --git a/src/Pages/ProgramConfig.elm b/src/Pages/ProgramConfig.elm index 15ba86532..a053d1db7 100644 --- a/src/Pages/ProgramConfig.elm +++ b/src/Pages/ProgramConfig.elm @@ -26,6 +26,7 @@ import Pages.Navigation import Pages.PageUrl exposing (PageUrl) import Pages.SiteConfig exposing (SiteConfig) import PagesMsg exposing (PagesMsg) +import Server.Request import Url exposing (Url) import UrlPath exposing (UrlPath) @@ -50,8 +51,8 @@ type alias ProgramConfig userMsg userModel route pageData actionData sharedData , update : Form.Model -> Dict String (Pages.ConcurrentSubmission.ConcurrentSubmission actionData) -> Maybe Pages.Navigation.Navigation -> sharedData -> pageData -> Maybe Browser.Navigation.Key -> userMsg -> userModel -> ( userModel, effect ) , subscriptions : route -> UrlPath -> userModel -> Sub userMsg , sharedData : BackendTask FatalError sharedData - , data : Decode.Value -> route -> BackendTask FatalError (PageServerResponse pageData errorPage) - , action : Decode.Value -> route -> BackendTask FatalError (PageServerResponse actionData errorPage) + , data : Server.Request.Request -> route -> BackendTask FatalError (PageServerResponse pageData errorPage) + , action : Server.Request.Request -> route -> BackendTask FatalError (PageServerResponse actionData errorPage) , onActionData : actionData -> Maybe userMsg , view : Form.Model diff --git a/src/Server/Request.elm b/src/Server/Request.elm index c251a9d92..ff4337b20 100644 --- a/src/Server/Request.elm +++ b/src/Server/Request.elm @@ -4,18 +4,19 @@ module Server.Request exposing , formData, formDataWithServerValidation , rawFormData , rawUrl - , method, rawBody, allCookies, rawHeaders - , requestTime, optionalHeader, expectContentType, expectJsonBody + , method, rawBody, rawHeaders + , requestTime, optionalHeader, expectContentType , acceptMethod, acceptContentTypes , map, map2, oneOf, andMap, andThen , queryParam, expectQueryParam, queryParams - , cookie, expectCookie + , cookie , expectHeader , File, expectMultiPartFormPost , expectBody , map3, map4, map5, map6, map7, map8, map9 , Method(..), methodToString , errorsToString, errorToString, getDecoder, ValidationError + , Request, body, cookies, header, jsonBody, matchesContentType ) {-| @@ -55,7 +56,7 @@ module Server.Request exposing ## Cookies -@docs cookie, expectCookie +@docs cookie ## Headers @@ -593,12 +594,9 @@ rawHeaders = {-| -} -requestTime : Parser Time.Posix -requestTime = - Json.Decode.field "requestTime" - (Json.Decode.int |> Json.Decode.map Time.millisToPosix) - |> noErrors - |> Internal.Request.Parser +requestTime : Request -> Time.Posix +requestTime (Internal.Request.Request req) = + req.time noErrors : Json.Decode.Decoder value -> Json.Decode.Decoder ( Result ValidationError value, List ValidationError ) @@ -650,12 +648,9 @@ acceptMethod ( accepted1, accepted ) (Internal.Request.Parser decoder) = {-| -} -method : Parser Method -method = - Json.Decode.field "method" Json.Decode.string - |> Json.Decode.map methodFromString - |> noErrors - |> Internal.Request.Parser +method : Request -> Method +method (Internal.Request.Request req) = + req.method |> methodFromString appendError : ValidationError -> Json.Decode.Decoder ( value, List ValidationError ) -> Json.Decode.Decoder ( value, List ValidationError ) @@ -731,17 +726,12 @@ If there are multiple query params with the same name, the first one is returned See also [`expectQueryParam`](#expectQueryParam) and [`queryParams`](#queryParams), or [`rawUrl`](#rawUrl) if you need something more low-level. -} -queryParam : String -> Parser (Maybe String) -queryParam name = - rawUrl - |> andThen - (\url_ -> - url_ - |> Url.fromString - |> Maybe.andThen .query - |> Maybe.andThen (findFirstQueryParam name) - |> succeed - ) +queryParam : String -> Request -> Maybe String +queryParam name (Internal.Request.Request req) = + req.rawUrl + |> Url.fromString + |> Maybe.andThen .query + |> Maybe.andThen (findFirstQueryParam name) findFirstQueryParam : String -> String -> Maybe String @@ -765,17 +755,13 @@ findFirstQueryParam name queryString = -- parses into: Dict.fromList [("coupon", ["abc", "xyz"])] -} -queryParams : Parser (Dict String (List String)) -queryParams = - rawUrl - |> map - (\rawUrl_ -> - rawUrl_ - |> Url.fromString - |> Maybe.andThen .query - |> Maybe.map QueryParams.fromString - |> Maybe.withDefault Dict.empty - ) +queryParams : Request -> Dict String (List String) +queryParams (Internal.Request.Request req) = + req.rawUrl + |> Url.fromString + |> Maybe.andThen .query + |> Maybe.map QueryParams.fromString + |> Maybe.withDefault Dict.empty {-| This is a Request.Parser that will never match an HTTP request. Similar to `Json.Decode.fail`. @@ -854,6 +840,13 @@ rawUrl = |> Internal.Request.Parser +{-| -} +header : String -> Request -> Maybe String +header headerName (Internal.Request.Request req) = + req.rawHeaders + |> Dict.get (headerName |> String.toLower) + + {-| -} optionalHeader : String -> Parser (Maybe String) optionalHeader headerName = @@ -864,38 +857,16 @@ optionalHeader headerName = {-| -} -expectCookie : String -> Parser String -expectCookie name = - cookie name - |> andThen - (\maybeCookie -> - case maybeCookie of - Just justValue -> - succeed justValue - - Nothing -> - skipInternal (ValidationError ("Missing cookie " ++ name)) - ) +cookie : String -> Request -> Maybe String +cookie name (Internal.Request.Request req) = + req.cookies + |> Dict.get name {-| -} -cookie : String -> Parser (Maybe String) -cookie name = - allCookies - |> map (Dict.get name) - - -{-| -} -allCookies : Parser (Dict String String) -allCookies = - Json.Decode.field "headers" - (optionalField "cookie" - Json.Decode.string - |> Json.Decode.map (Maybe.map CookieParser.parse) - ) - |> Json.Decode.map (Maybe.withDefault Dict.empty) - |> noErrors - |> Internal.Request.Parser +cookies : Request -> Dict String String +cookies (Internal.Request.Request req) = + req.cookies formField_ : String -> Parser String @@ -963,51 +934,54 @@ runForm validation = {-| -} formDataWithServerValidation : Pages.Form.Handler error combined - -> Parser (BackendTask FatalError (Result (Form.ServerResponse error) ( Form.ServerResponse error, combined ))) -formDataWithServerValidation formParsers = - rawFormData - |> andThen - (\rawFormData_ -> - case Form.Handler.run rawFormData_ formParsers of - Form.Valid decoded -> - succeed - (decoded - |> BackendTask.map - (\clientValidated -> - case runForm clientValidated of - Form.Valid decodedFinal -> - Ok - ( { persisted = + -> Request + -> Maybe (BackendTask FatalError (Result (Form.ServerResponse error) ( Form.ServerResponse error, combined ))) +formDataWithServerValidation formParsers (Internal.Request.Request req) = + case req.body of + Nothing -> + Nothing + + Just body_ -> + FormData.parseToList body_ + |> (\rawFormData_ -> + case Form.Handler.run rawFormData_ formParsers of + Form.Valid decoded -> + decoded + |> BackendTask.map + (\clientValidated -> + case runForm clientValidated of + Form.Valid decodedFinal -> + Ok + ( { persisted = + { fields = Just rawFormData_ + , clientSideErrors = Nothing + } + , serverSideErrors = Dict.empty + } + , decodedFinal + ) + + Form.Invalid _ errors2 -> + Err + { persisted = { fields = Just rawFormData_ - , clientSideErrors = Nothing + , clientSideErrors = Just errors2 } - , serverSideErrors = Dict.empty - } - , decodedFinal - ) - - Form.Invalid _ errors2 -> - Err - { persisted = - { fields = Just rawFormData_ - , clientSideErrors = Just errors2 + , serverSideErrors = Dict.empty } - , serverSideErrors = Dict.empty - } - ) - ) + ) - Form.Invalid _ errors -> - Err - { persisted = - { fields = Just rawFormData_ - , clientSideErrors = Just errors - } - , serverSideErrors = Dict.empty - } - |> BackendTask.succeed - |> succeed - ) + Form.Invalid _ errors -> + Err + { persisted = + { fields = Just rawFormData_ + , clientSideErrors = Just errors + } + , serverSideErrors = Dict.empty + } + |> BackendTask.succeed + ) + |> Just {-| Takes a [`Form.Handler.Handler`](https://package.elm-lang.org/packages/dillonkearns/elm-form/latest/Form-Handler) and @@ -1091,10 +1065,12 @@ So you will want to handle any `Form`'s rendered using `withGetMethod` in your R -} formData : Form.Handler.Handler error combined - -> Parser ( Form.ServerResponse error, Form.Validated error combined ) -formData formParsers = - rawFormData - |> andThen + -> Request + -> Maybe ( Form.ServerResponse error, Form.Validated error combined ) +formData formParsers ((Internal.Request.Request req) as request) = + request + |> rawFormData + |> Maybe.map (\rawFormData_ -> case Form.Handler.run rawFormData_ formParsers of (Form.Valid _) as validated -> @@ -1106,7 +1082,6 @@ formData formParsers = } , validated ) - |> succeed (Form.Invalid _ maybeErrors) as validated -> ( { persisted = @@ -1117,7 +1092,6 @@ formData formParsers = } , validated ) - |> succeed ) @@ -1137,71 +1111,25 @@ By default, [`Form`]'s are rendered with a `POST` method, and you can configure So you will want to handle any `Form`'s rendered using `withGetMethod` in your Route's `data` function, or otherwise handle forms in `action`. -} -rawFormData : Parser (List ( String, String )) -rawFormData = - -- TODO make an optional version - map4 (\parsedContentType a b c -> ( ( a, parsedContentType ), b, c )) - (rawContentType |> map (Maybe.map parseContentType)) - (matchesContentType "application/x-www-form-urlencoded") - method - (rawBody |> map (Maybe.withDefault "") - -- TODO warn of empty body in case when field decoding fails? - ) - |> andThen - (\( ( validContentType, parsedContentType ), validMethod, justBody ) -> - if validMethod == Get then - queryParams - |> map Dict.toList - |> map (List.map (Tuple.mapSecond (List.head >> Maybe.withDefault ""))) - - else if not ((validContentType |> Maybe.withDefault False) && validMethod == Post) then - Json.Decode.succeed - ( Err - (ValidationError <| - case ( validContentType |> Maybe.withDefault False, validMethod == Post, parsedContentType ) of - ( False, True, Just contentType_ ) -> - "expectFormPost did not match - Was form POST but expected content-type `application/x-www-form-urlencoded` and instead got `" ++ contentType_ ++ "`" - - ( False, True, Nothing ) -> - "expectFormPost did not match - Was form POST but expected content-type `application/x-www-form-urlencoded` but the request didn't have a content-type header" - - _ -> - "expectFormPost did not match - expected method POST, but the method was " ++ methodToString validMethod - ) - , [] - ) - |> Internal.Request.Parser - - else +rawFormData : Request -> Maybe (List ( String, String )) +rawFormData request = + if method request == Get then + request + |> queryParams + |> Dict.toList + |> List.map (Tuple.mapSecond (List.head >> Maybe.withDefault "")) + |> Just + + else if (method request == Post) && (request |> matchesContentType "application/x-www-form-urlencoded") then + body request + |> Maybe.map + (\justBody -> justBody - |> FormData.parse - |> succeed - |> andThen - (\parsedForm -> - let - thing : Json.Encode.Value - thing = - parsedForm - |> Dict.toList - |> List.map - (Tuple.mapSecond - (\( first, _ ) -> - Json.Encode.string first - ) - ) - |> Json.Encode.object - - innerDecoder : Json.Decode.Decoder ( Result ValidationError (List ( String, String )), List ValidationError ) - innerDecoder = - Json.Decode.keyValuePairs Json.Decode.string - |> noErrors - in - Json.Decode.decodeValue innerDecoder thing - |> Result.mapError Json.Decode.errorToString - |> jsonFromResult - |> Internal.Request.Parser - ) - ) + |> FormData.parseToList + ) + + else + Nothing {-| -} @@ -1262,25 +1190,18 @@ rawContentType = |> Internal.Request.Parser -matchesContentType : String -> Parser (Maybe Bool) -matchesContentType expectedContentType = - optionalField ("content-type" |> String.toLower) Json.Decode.string - |> Json.Decode.field "headers" - |> Json.Decode.map - (\maybeContentType -> +matchesContentType : String -> Request -> Bool +matchesContentType expectedContentType (Internal.Request.Request req) = + req.rawHeaders + |> Dict.get "content-type" + |> (\maybeContentType -> case maybeContentType of Nothing -> - Nothing + False Just contentType -> - if (contentType |> parseContentType) == (expectedContentType |> parseContentType) then - Just True - - else - Just False - ) - |> noErrors - |> Internal.Request.Parser + (contentType |> parseContentType) == (expectedContentType |> parseContentType) + ) parseContentType : String -> String @@ -1293,26 +1214,15 @@ parseContentType contentTypeString = {-| -} -expectJsonBody : Json.Decode.Decoder value -> Parser value -expectJsonBody jsonBodyDecoder = - map2 (\_ secondValue -> secondValue) - (expectContentType "application/json") - (rawBody - |> andThen - (\rawBody_ -> - (case rawBody_ of - Just body_ -> - Json.Decode.decodeString - jsonBodyDecoder - body_ - |> Result.mapError Json.Decode.errorToString - - Nothing -> - Err "Tried to parse JSON body but the request had no body." - ) - |> fromResult - ) - ) +jsonBody : Json.Decode.Decoder value -> Request -> Maybe (Result Json.Decode.Error value) +jsonBody jsonBodyDecoder ((Internal.Request.Request req) as request) = + case ( req.body, request |> matchesContentType "application/json" ) of + ( Just body_, True ) -> + Json.Decode.decodeString jsonBodyDecoder body_ + |> Just + + _ -> + Nothing {-| -} @@ -1416,3 +1326,13 @@ methodToString method_ = NonStandard nonStandardMethod -> nonStandardMethod + + +type alias Request = + Internal.Request.Request + + +{-| -} +body : Request -> Maybe String +body (Internal.Request.Request req) = + req.body diff --git a/src/Server/Session.elm b/src/Server/Session.elm index fad669814..f55f3fcea 100644 --- a/src/Server/Session.elm +++ b/src/Server/Session.elm @@ -113,7 +113,7 @@ import BackendTask.Internal.Request import Dict exposing (Dict) import Json.Decode import Json.Encode -import Server.Request +import Server.Request exposing (Request) import Server.Response exposing (Response) import Server.SetCookie as SetCookie @@ -245,18 +245,17 @@ withSession : , secrets : BackendTask error (List String) , options : Maybe SetCookie.Options } - -> (request -> Session -> BackendTask error ( Session, Response data errorPage )) - -> Server.Request.Parser request - -> Server.Request.Parser (BackendTask error (Response data errorPage)) -withSession config toRequest userRequest = - withSessionResult config - (\request session -> - toRequest request - (session + -> (Session -> BackendTask error ( Session, Response data errorPage )) + -> Request + -> BackendTask error (Response data errorPage) +withSession config toRequest request_ = + request_ + |> withSessionResult config + (\session -> + session |> Result.withDefault empty - ) - ) - userRequest + |> toRequest + ) {-| -} @@ -265,39 +264,34 @@ withSessionResult : , secrets : BackendTask error (List String) , options : Maybe SetCookie.Options } - -> (request -> Result NotLoadedReason Session -> BackendTask error ( Session, Response data errorPage )) - -> Server.Request.Parser request - -> Server.Request.Parser (BackendTask error (Response data errorPage)) -withSessionResult config toRequest userRequest = - Server.Request.map2 - (\maybeSessionCookie userRequestData -> - let - unsigned : BackendTask error (Result NotLoadedReason Session) - unsigned = - case maybeSessionCookie of - Just sessionCookie -> - sessionCookie - |> unsignCookie config - |> BackendTask.map - (\unsignResult -> - case unsignResult of - Ok decoded -> - Ok decoded - - Err () -> - Err InvalidSessionCookie - ) + -> (Result NotLoadedReason Session -> BackendTask error ( Session, Response data errorPage )) + -> Request + -> BackendTask error (Response data errorPage) +withSessionResult config toTask request = + let + unsigned : BackendTask error (Result NotLoadedReason Session) + unsigned = + case Server.Request.cookie config.name request of + Just sessionCookie -> + sessionCookie + |> unsignCookie config + |> BackendTask.map + (\unsignResult -> + case unsignResult of + Ok decoded -> + Ok decoded + + Err () -> + Err InvalidSessionCookie + ) - Nothing -> - Err NoSessionCookie - |> BackendTask.succeed - in - unsigned - |> BackendTask.andThen - (encodeSessionUpdate config toRequest userRequestData) - ) - (Server.Request.cookie config.name) - userRequest + Nothing -> + Err NoSessionCookie + |> BackendTask.succeed + in + unsigned + |> BackendTask.andThen + (encodeSessionUpdate config toTask) encodeSessionUpdate : @@ -305,13 +299,12 @@ encodeSessionUpdate : , secrets : BackendTask error (List String) , options : Maybe SetCookie.Options } - -> (c -> d -> BackendTask error ( Session, Response data errorPage )) - -> c + -> (d -> BackendTask error ( Session, Response data errorPage )) -> d -> BackendTask error (Response data errorPage) -encodeSessionUpdate config toRequest userRequestData sessionResult = +encodeSessionUpdate config toRequest sessionResult = sessionResult - |> toRequest userRequestData + |> toRequest |> BackendTask.andThen (\( sessionUpdate, response ) -> BackendTask.map