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

Migrate away from parser-style Request.Parser.

Browse Source
This commit is contained in:
Dillon Kearns 2023-05-27 10:21:10 -07:00
parent 7935b9bdfa
commit 27999b3186
27 changed files with 807 additions and 970 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
codegen/GenerateMain.elm
View File

@ -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

71
examples/blog-engine/app/Route/Admin/Slug_.elm
View File

@ -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
}
|> 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
}
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
)
)
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

72
examples/blog-engine/app/Route/Posts/Slug_.elm
View File

@ -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
-> 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
)
)
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 {})

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

@ -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

21
examples/end-to-end/app/Route/CookieTest.elm
View File

@ -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 :

103
examples/end-to-end/app/Route/DarkMode.elm
View File

@ -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
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
}
)
)
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
(\sessionResult ->
case request |> Server.Request.formData (form |> Form.Handler.init identity) of
Nothing ->
"Expected form submission." |> FatalError.fromString |> BackendTask.fail
Form.Invalid _ _ ->
False
Just ( response, formPost ) ->
let
setToDarkMode : Bool
setToDarkMode =
case formPost of
Form.Valid ok ->
ok
session : Session.Session
session =
sessionResult
|> Result.withDefault Session.empty
in
BackendTask.succeed
( session
|> Session.insert "darkMode"
(if setToDarkMode then
"dark"
Form.Invalid _ _ ->
False
else
""
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)
)
)

14
examples/end-to-end/app/Route/ErrorHandling.elm
View File

@ -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 :

88
examples/end-to-end/app/Route/Fetcher.elm
View File

@ -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
)
-> Request
-> BackendTask FatalError (Server.Response.Response ActionData ErrorPage.ErrorPage)
action routeParams request =
case request |> Server.Request.formData forms of
Nothing ->
Debug.todo "TODO"
Form.Valid DeleteAll ->
BackendTask.Custom.run "deleteAllItems"
Encode.null
(Decode.list Decode.string)
|> BackendTask.allowFatal
|> BackendTask.map
(\_ ->
Server.Response.render ActionData
)
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.Invalid _ _ ->
BackendTask.succeed
(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

40
examples/end-to-end/app/Route/Form.elm
View File

@ -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 :

45
examples/end-to-end/app/Route/GetForm.elm
View File

@ -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
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
Form.Invalid _ _ ->
Data { page = 1 }
|> Server.Response.render
|> BackendTask.succeed
)
Just ( 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
action : RouteParams -> Parser (BackendTask FatalError (Server.Response.Response ActionData ErrorPage))
action routeParams =
Request.succeed
(Server.Response.render {}
|> BackendTask.succeed
)
action : RouteParams -> Request -> BackendTask FatalError (Server.Response.Response ActionData ErrorPage)
action routeParams request =
Server.Response.render {}
|> BackendTask.succeed
head :

85
examples/end-to-end/app/Route/Greet.elm
View File

@ -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"
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
flashMessage : Maybe String
flashMessage =
session
|> Session.get "message"
in
( session
, { username = username
, requestTime = requestTime
, flashMessage = flashMessage
}
|> Response.render
|> Response.withHeader
"x-greeting"
("hello " ++ username ++ "!")
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 :

10
examples/end-to-end/app/Route/Hello.elm
View File

@ -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 :

109
examples/end-to-end/app/Route/Login.elm
View File

@ -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
}
)
(\session ->
case request |> Request.formDataWithServerValidation (form |> Form.Handler.init identity) of
Nothing ->
BackendTask.fail (FatalError.fromString "Invalid form response")
Ok ( _, name ) ->
( session
|> Result.withDefault Session.empty
|> Session.insert "name" name
|> Session.withFlash "message" ("Welcome " ++ name ++ "!")
, Route.redirectTo Route.Greet
)
)
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
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
)
]
_ ->
( Session.empty
, { username = Nothing, flashMessage = Nothing }
|> Response.render
)
|> BackendTask.succeed
)
head :

16
examples/end-to-end/app/Route/Logout.elm
View File

@ -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 :

128
examples/end-to-end/app/Route/Redirect.elm
View File

@ -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"

60
examples/end-to-end/app/Route/Test/BasicAuth.elm
View File

@ -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
-> 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
)
else
requireBasicAuth |> BackendTask.succeed
)
Nothing ->
requireBasicAuth
|> BackendTask.succeed
)
Nothing ->
requireBasicAuth
|> BackendTask.succeed
requireBasicAuth : Response data errorPage

18
examples/end-to-end/app/Route/Test/ResponseHeaders.elm
View File

@ -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")

8
examples/end-to-end/cypress/e2e/api-routes.cy.ts
View File

@ -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."
);
});
});

32
examples/end-to-end/src/MySession.elm
View File

@ -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 =

66
generator/src/RouteBuilder.elm
View File

@ -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

34
src/ApiRoute.elm
View File

@ -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

22
src/FormData.elm
View File

@ -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

90
src/Internal/Request.elm
View File

@ -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

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

@ -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
)

5
src/Pages/ProgramConfig.elm
View File

@ -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

340
src/Server/Request.elm
View File

@ -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 "")))
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 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
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
|> FormData.parseToList
)
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
)
)
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
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 ->
Err "Tried to parse JSON body but the request had no body."
)
|> fromResult
)
)
_ ->
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

87
src/Server/Session.elm
View File

@ -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
-> (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
)
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