/
Login.elm
315 lines (234 loc) · 7.47 KB
/
Login.elm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
module Page.Login exposing (Model, Msg, init, subscriptions, toSession, update, view)
{-| The login page.
-}
import Api exposing (Cred)
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)
-- MODEL
type alias Model =
{ session : Session
, problems : List Problem
, form : Form
}
{-| Recording validation problems on a per-field basis facilitates displaying
them inline next to the field where the error occurred.
I implemented it this way out of habit, then realized the spec called for
displaying all the errors at the top. I thought about simplifying it, but then
figured it'd be useful to show how I would normally model this data - assuming
the intended UX was to render errors per field.
(The other part of this is having a view function like this:
viewFieldErrors : ValidatedField -> List Problem -> Html msg
...and it filters the list of problems to render only InvalidEntry ones for the
given ValidatedField. That way you can call this:
viewFieldErrors Email problems
...next to the `email` field, and call `viewFieldErrors Password problems`
next to the `password` field, and so on.
The `LoginError` should be displayed elsewhere, since it doesn't correspond to
a particular field.
-}
type Problem
= InvalidEntry ValidatedField String
| ServerError String
type alias Form =
{ email : String
, password : String
}
init : Session -> ( Model, Cmd msg )
init session =
( { session = session
, problems = []
, form =
{ email = ""
, password = ""
}
}
, Cmd.none
)
-- VIEW
view : Model -> { title : String, content : Html Msg }
view model =
{ title = "Login"
, 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 in" ]
, p [ class "text-xs-center" ]
[ a [ Route.href Route.Register ]
[ text "Need an account?" ]
]
, ul [ class "error-messages" ]
(List.map viewProblem model.problems)
, viewForm model.form
]
]
]
]
}
viewProblem : Problem -> Html msg
viewProblem problem =
let
errorMessage =
case problem of
InvalidEntry _ str ->
str
ServerError str ->
str
in
li [] [ text errorMessage ]
viewForm : Form -> Html Msg
viewForm form =
Html.form [ onSubmit SubmittedForm ]
[ 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 in" ]
]
-- UPDATE
type Msg
= SubmittedForm
| EnteredEmail String
| EnteredPassword String
| CompletedLogin (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 CompletedLogin (login validForm)
)
Err problems ->
( { model | problems = problems }
, Cmd.none
)
EnteredEmail email ->
updateForm (\form -> { form | email = email }) model
EnteredPassword password ->
updateForm (\form -> { form | password = password }) model
CompletedLogin (Err error) ->
let
serverErrors =
Api.decodeErrors error
|> List.map ServerError
in
( { model | problems = List.append model.problems serverErrors }
, Cmd.none
)
CompletedLogin (Ok viewer) ->
( model
, Viewer.store viewer
)
GotSession session ->
( { model | session = session }
, Route.replaceUrl (Session.navKey session) Route.Home
)
{-| Helper function for `update`. Updates the form and returns Cmd.none.
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)
-- 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
= Email
| Password
fieldsToValidate : List ValidatedField
fieldsToValidate =
[ 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
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
[]
{-| Don't trim while the user is typing! That would be super annoying.
Instead, trim only on submit.
-}
trimFields : Form -> TrimmedForm
trimFields form =
Trimmed
{ email = String.trim form.email
, password = String.trim form.password
}
-- HTTP
login : TrimmedForm -> Http.Request Viewer
login (Trimmed form) =
let
user =
Encode.object
[ ( "email", Encode.string form.email )
, ( "password", Encode.string form.password )
]
body =
Encode.object [ ( "user", user ) ]
|> Http.jsonBody
in
Api.login body Viewer.decoder
-- EXPORT
toSession : Model -> Session
toSession model =
model.session