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 -> case validate model.form of Ok validForm -> ( { model | problems = [] } , Http.send CompletedRegister (register validForm) ) Err problems -> ( { model | problems = problems } , Cmd.none ) 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 ) -- 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 } -- HTTP register : TrimmedForm -> Http.Request Viewer register (Trimmed form) = let user = Encode.object [ ( "username", Encode.string form.username ) , ( "email", Encode.string form.email ) , ( "password", Encode.string form.password ) ] body = Encode.object [ ( "user", user ) ] |> Http.jsonBody in Decode.field "user" Viewer.decoder |> Http.post (Api.url [ "users" ]) body