341 lines
8.6 KiB
Elm
341 lines
8.6 KiB
Elm
module Page.Register exposing (Model, Msg, init, subscriptions, toSession, update, view)
|
|
|
|
import Api
|
|
import Browser.Navigation as Nav
|
|
import Html exposing (..)
|
|
import Html.Attributes exposing (..)
|
|
import Html.Events exposing (..)
|
|
import Http
|
|
import Json.Decode as Decode exposing (Decoder, decodeString, field, string)
|
|
import Json.Decode.Pipeline exposing (optional)
|
|
import Json.Encode as Encode
|
|
import Route exposing (Route)
|
|
import Session exposing (Session)
|
|
import Viewer exposing (Viewer)
|
|
import Viewer.Cred as Cred exposing (Cred)
|
|
|
|
|
|
|
|
-- MODEL
|
|
|
|
|
|
type alias Model =
|
|
{ session : Session
|
|
, problems : List Problem
|
|
, form : Form
|
|
}
|
|
|
|
|
|
type alias Form =
|
|
{ email : String
|
|
, username : String
|
|
, password : String
|
|
}
|
|
|
|
|
|
type Problem
|
|
= InvalidEntry ValidatedField String
|
|
| ServerError String
|
|
|
|
|
|
init : Session -> ( Model, Cmd msg )
|
|
init session =
|
|
( { session = session
|
|
, problems = []
|
|
, form =
|
|
{ email = ""
|
|
, username = ""
|
|
, password = ""
|
|
}
|
|
}
|
|
, Cmd.none
|
|
)
|
|
|
|
|
|
|
|
-- VIEW
|
|
|
|
|
|
view : Model -> { title : String, content : Html Msg }
|
|
view model =
|
|
{ title = "Register"
|
|
, content =
|
|
div [ class "cred-page" ]
|
|
[ div [ class "container page" ]
|
|
[ div [ class "row" ]
|
|
[ div [ class "col-md-6 offset-md-3 col-xs-12" ]
|
|
[ h1 [ class "text-xs-center" ] [ text "Sign up" ]
|
|
, p [ class "text-xs-center" ]
|
|
[ a [ Route.href Route.Login ]
|
|
[ text "Have an account?" ]
|
|
]
|
|
, ul [ class "error-messages" ]
|
|
(List.map viewProblem model.problems)
|
|
, viewForm model.form
|
|
]
|
|
]
|
|
]
|
|
]
|
|
}
|
|
|
|
|
|
viewForm : Form -> Html Msg
|
|
viewForm form =
|
|
Html.form [ onSubmit SubmittedForm ]
|
|
[ fieldset [ class "form-group" ]
|
|
[ input
|
|
[ class "form-control form-control-lg"
|
|
, placeholder "Username"
|
|
, onInput EnteredUsername
|
|
, value form.username
|
|
]
|
|
[]
|
|
]
|
|
, fieldset [ class "form-group" ]
|
|
[ input
|
|
[ class "form-control form-control-lg"
|
|
, placeholder "Email"
|
|
, onInput EnteredEmail
|
|
, value form.email
|
|
]
|
|
[]
|
|
]
|
|
, fieldset [ class "form-group" ]
|
|
[ input
|
|
[ class "form-control form-control-lg"
|
|
, type_ "password"
|
|
, placeholder "Password"
|
|
, onInput EnteredPassword
|
|
, value form.password
|
|
]
|
|
[]
|
|
]
|
|
, button [ class "btn btn-lg btn-primary pull-xs-right" ]
|
|
[ text "Sign up" ]
|
|
]
|
|
|
|
|
|
viewProblem : Problem -> Html msg
|
|
viewProblem problem =
|
|
let
|
|
errorMessage =
|
|
case problem of
|
|
InvalidEntry _ str ->
|
|
str
|
|
|
|
ServerError str ->
|
|
str
|
|
in
|
|
li [] [ text errorMessage ]
|
|
|
|
|
|
|
|
-- UPDATE
|
|
|
|
|
|
type Msg
|
|
= SubmittedForm
|
|
| EnteredEmail String
|
|
| EnteredUsername String
|
|
| EnteredPassword String
|
|
| CompletedRegister (Result Http.Error Viewer)
|
|
| GotSession Session
|
|
|
|
|
|
update : Msg -> Model -> ( Model, Cmd Msg )
|
|
update msg model =
|
|
case msg of
|
|
SubmittedForm ->
|
|
let
|
|
requestBody : Http.Body
|
|
requestBody =
|
|
encodeJsonBody model.form
|
|
|
|
responseDecoder : Decoder Viewer
|
|
responseDecoder =
|
|
Decode.field "user" Viewer.decoder
|
|
|
|
{- 👉 TODO: Create a Http.Request value that represents
|
|
a POST request to "/api/users"
|
|
|
|
💡 HINT 1: Documentation for `Http.post` is here:
|
|
|
|
http://package.elm-lang.org/packages/elm-lang/http/1.0.0/Http#post
|
|
|
|
💡 HINT 2: Look at the values defined above in this
|
|
let-expression. What are their types? What are the types the
|
|
`Http.post` function is looking for?
|
|
-}
|
|
request : Http.Request Viewer
|
|
request =
|
|
Debug.todo "Call Http.post to represent a POST to /api/users"
|
|
|
|
{- 👉 TODO: Use Http.send to turn the request we just defined
|
|
into a Cmd for `update` to execute.
|
|
|
|
💡 HINT 1: Documentation for `Http.send` is here:
|
|
|
|
http://package.elm-lang.org/packages/elm-lang/http/1.0.0/Http#send
|
|
|
|
💡 HINT 2: The `CompletedRegister` variant defined in `type Msg`
|
|
will be useful here!
|
|
-}
|
|
cmd : Cmd Msg
|
|
cmd =
|
|
Cmd.none
|
|
in
|
|
( { model | problems = [] }, cmd )
|
|
|
|
EnteredUsername username ->
|
|
updateForm (\form -> { form | username = username }) model
|
|
|
|
EnteredEmail email ->
|
|
updateForm (\form -> { form | email = email }) model
|
|
|
|
EnteredPassword password ->
|
|
updateForm (\form -> { form | password = password }) model
|
|
|
|
CompletedRegister (Err error) ->
|
|
let
|
|
serverErrors =
|
|
Api.decodeErrors error
|
|
|> List.map ServerError
|
|
in
|
|
( { model | problems = List.append model.problems serverErrors }
|
|
, Cmd.none
|
|
)
|
|
|
|
CompletedRegister (Ok viewer) ->
|
|
( model
|
|
, Session.login viewer
|
|
)
|
|
|
|
GotSession session ->
|
|
( { model | session = session }
|
|
, Route.replaceUrl (Session.navKey session) Route.Home
|
|
)
|
|
|
|
|
|
{-| Helper function for `update`. Updates the form and returns Cmd.none and
|
|
Ignored. Useful for recording form fields!
|
|
-}
|
|
updateForm : (Form -> Form) -> Model -> ( Model, Cmd Msg )
|
|
updateForm transform model =
|
|
( { model | form = transform model.form }, Cmd.none )
|
|
|
|
|
|
encodeJsonBody : Form -> Http.Body
|
|
encodeJsonBody form =
|
|
let
|
|
user =
|
|
Encode.object
|
|
[ ( "username", Encode.string form.username )
|
|
, ( "email", Encode.string form.email )
|
|
, ( "password", Encode.string form.password )
|
|
]
|
|
in
|
|
Encode.object [ ( "user", user ) ]
|
|
|> Http.jsonBody
|
|
|
|
|
|
|
|
-- SUBSCRIPTIONS
|
|
|
|
|
|
subscriptions : Model -> Sub Msg
|
|
subscriptions model =
|
|
Session.changes GotSession (Session.navKey model.session)
|
|
|
|
|
|
|
|
-- EXPORT
|
|
|
|
|
|
toSession : Model -> Session
|
|
toSession model =
|
|
model.session
|
|
|
|
|
|
|
|
-- FORM
|
|
|
|
|
|
{-| Marks that we've trimmed the form's fields, so we don't accidentally send
|
|
it to the server without having trimmed it!
|
|
-}
|
|
type TrimmedForm
|
|
= Trimmed Form
|
|
|
|
|
|
{-| When adding a variant here, add it to `fieldsToValidate` too!
|
|
-}
|
|
type ValidatedField
|
|
= Username
|
|
| Email
|
|
| Password
|
|
|
|
|
|
fieldsToValidate : List ValidatedField
|
|
fieldsToValidate =
|
|
[ Username
|
|
, Email
|
|
, Password
|
|
]
|
|
|
|
|
|
{-| Trim the form and validate its fields. If there are problems, report them!
|
|
-}
|
|
validate : Form -> Result (List Problem) TrimmedForm
|
|
validate form =
|
|
let
|
|
trimmedForm =
|
|
trimFields form
|
|
in
|
|
case List.concatMap (validateField trimmedForm) fieldsToValidate of
|
|
[] ->
|
|
Ok trimmedForm
|
|
|
|
problems ->
|
|
Err problems
|
|
|
|
|
|
validateField : TrimmedForm -> ValidatedField -> List Problem
|
|
validateField (Trimmed form) field =
|
|
List.map (InvalidEntry field) <|
|
|
case field of
|
|
Username ->
|
|
if String.isEmpty form.username then
|
|
[ "username can't be blank." ]
|
|
|
|
else
|
|
[]
|
|
|
|
Email ->
|
|
if String.isEmpty form.email then
|
|
[ "email can't be blank." ]
|
|
|
|
else
|
|
[]
|
|
|
|
Password ->
|
|
if String.isEmpty form.password then
|
|
[ "password can't be blank." ]
|
|
|
|
else if String.length form.password < Viewer.minPasswordChars then
|
|
[ "password must be at least " ++ String.fromInt Viewer.minPasswordChars ++ " characters long." ]
|
|
|
|
else
|
|
[]
|
|
|
|
|
|
{-| Don't trim while the user is typing! That would be super annoying.
|
|
Instead, trim only on submit.
|
|
-}
|
|
trimFields : Form -> TrimmedForm
|
|
trimFields form =
|
|
Trimmed
|
|
{ username = String.trim form.username
|
|
, email = String.trim form.email
|
|
, password = String.trim form.password
|
|
}
|