all repos

onasty @ 9c8b9eae5400bed303e3892d640786b0cb0b3554

a one-time notes service

onasty/web/src/Effect.elm (view raw)

Smirnov Oleksandr Smirnov Oleksandr
ss2316544@gmail.com
web: prompt user to check email to verifiy after signing up (#139)..., 11 months ago
1
module Effect exposing
2
    ( Effect
3
    , none, batch
4
    , sendCmd, sendMsg
5
    , pushRoute, replaceRoute
6
    , pushRoutePath, replaceRoutePath
7
    , loadExternalUrl, back
8
    , sendApiRequest, refreshTokens
9
    , signin, logout, saveUser, clearUser
10
    , map, toCmd
11
    )
12
13
{-|
14
15
@docs Effect
16
17
@docs none, batch
18
@docs sendCmd, sendMsg
19
20
@docs pushRoute, replaceRoute
21
@docs pushRoutePath, replaceRoutePath
22
@docs loadExternalUrl, back
23
24
@docs sendApiRequest, refreshTokens
25
@docs signin, logout, saveUser, clearUser
26
27
@docs map, toCmd
28
29
-}
30
31
import Api
32
import Auth.User
33
import Browser.Navigation
34
import Data.Credentials exposing (Credentials)
35
import Data.Error
36
import Dict exposing (Dict)
37
import Http
38
import Json.Decode
39
import Json.Encode
40
import Ports exposing (sendToLocalStorage)
41
import Route
42
import Route.Path
43
import Shared.Model
44
import Shared.Msg
45
import Task
46
import Url exposing (Url)
47
48
49
type Effect msg
50
    = -- BASICS
51
      None
52
    | Batch (List (Effect msg))
53
    | SendCmd (Cmd msg)
54
      -- ROUTING
55
    | PushUrl String
56
    | ReplaceUrl String
57
    | LoadExternalUrl String
58
    | Back
59
      -- SHARED
60
    | SendSharedMsg Shared.Msg.Msg
61
    | SendToLocalStorage { key : String, value : Json.Encode.Value }
62
    | SendApiRequest (HttpRequestDetails msg)
63
64
65
type alias HttpRequestDetails msg =
66
    { endpoint : String
67
    , method : String
68
    , body : Http.Body
69
    , decoder : Json.Decode.Decoder msg
70
    , onHttpError : Api.Error -> msg
71
    }
72
73
74
75
-- BASICS
76
77
78
{-| Don't send any effect.
79
-}
80
none : Effect msg
81
none =
82
    None
83
84
85
{-| Send multiple effects at once.
86
-}
87
batch : List (Effect msg) -> Effect msg
88
batch =
89
    Batch
90
91
92
{-| Send a normal `Cmd msg` as an effect, something like `Http.get` or `Random.generate`.
93
-}
94
sendCmd : Cmd msg -> Effect msg
95
sendCmd =
96
    SendCmd
97
98
99
{-| Send a message as an effect. Useful when emitting events from UI components.
100
-}
101
sendMsg : msg -> Effect msg
102
sendMsg msg =
103
    Task.succeed msg
104
        |> Task.perform identity
105
        |> SendCmd
106
107
108
109
-- ROUTING
110
111
112
{-| Set the new route, and make the back button go back to the current route.
113
-}
114
pushRoute :
115
    { path : Route.Path.Path
116
    , query : Dict String String
117
    , hash : Maybe String
118
    }
119
    -> Effect msg
120
pushRoute route =
121
    PushUrl (Route.toString route)
122
123
124
{-| Same as `Effect.pushRoute`, but without `query` or `hash` support
125
-}
126
pushRoutePath : Route.Path.Path -> Effect msg
127
pushRoutePath path =
128
    PushUrl (Route.Path.toString path)
129
130
131
{-| Set the new route, but replace the previous one, so clicking the back
132
button **won't** go back to the previous route.
133
-}
134
replaceRoute :
135
    { path : Route.Path.Path
136
    , query : Dict String String
137
    , hash : Maybe String
138
    }
139
    -> Effect msg
140
replaceRoute route =
141
    ReplaceUrl (Route.toString route)
142
143
144
{-| Same as `Effect.replaceRoute`, but without `query` or `hash` support
145
-}
146
replaceRoutePath : Route.Path.Path -> Effect msg
147
replaceRoutePath path =
148
    ReplaceUrl (Route.Path.toString path)
149
150
151
{-| Redirect users to a new URL, somewhere external to your web application.
152
-}
153
loadExternalUrl : String -> Effect msg
154
loadExternalUrl =
155
    LoadExternalUrl
156
157
158
{-| Navigate back one page
159
-}
160
back : Effect msg
161
back =
162
    Back
163
164
165
166
-- SHARED
167
168
169
sendApiRequest :
170
    { endpoint : String
171
    , method : String
172
    , body : Http.Body
173
    , decoder : Json.Decode.Decoder value
174
    , onResponse : Result Api.Error value -> msg
175
    }
176
    -> Effect msg
177
sendApiRequest opts =
178
    let
179
        onHttpError : Api.Error -> msg
180
        onHttpError err =
181
            opts.onResponse (Err err)
182
183
        decoder : Json.Decode.Decoder msg
184
        decoder =
185
            opts.decoder
186
                |> Json.Decode.map Ok
187
                |> Json.Decode.map opts.onResponse
188
    in
189
    SendApiRequest
190
        { endpoint = opts.endpoint
191
        , method = opts.method
192
        , body = opts.body
193
        , onHttpError = onHttpError
194
        , decoder = decoder
195
        }
196
197
198
refreshTokens : Effect msg
199
refreshTokens =
200
    SendSharedMsg Shared.Msg.TriggerTokenRefresh
201
202
203
signin : Credentials -> Effect msg
204
signin credentials =
205
    SendSharedMsg (Shared.Msg.SignedIn credentials)
206
207
208
logout : Effect msg
209
logout =
210
    SendSharedMsg Shared.Msg.Logout
211
212
213
saveUser : String -> String -> Effect msg
214
saveUser accessToken refreshToken =
215
    batch
216
        [ SendToLocalStorage { key = "access_token", value = Json.Encode.string accessToken }
217
        , SendToLocalStorage { key = "refresh_token", value = Json.Encode.string refreshToken }
218
        ]
219
220
221
clearUser : Effect msg
222
clearUser =
223
    batch
224
        [ SendToLocalStorage { key = "access_token", value = Json.Encode.null }
225
        , SendToLocalStorage { key = "refresh_token", value = Json.Encode.null }
226
        ]
227
228
229
230
-- INTERNALS
231
232
233
{-| Elm Land depends on this function to connect pages and layouts
234
together into the overall app.
235
-}
236
map : (msg1 -> msg2) -> Effect msg1 -> Effect msg2
237
map fn effect =
238
    case effect of
239
        None ->
240
            None
241
242
        Batch list ->
243
            Batch (List.map (map fn) list)
244
245
        SendCmd cmd ->
246
            SendCmd (Cmd.map fn cmd)
247
248
        PushUrl url ->
249
            PushUrl url
250
251
        ReplaceUrl url ->
252
            ReplaceUrl url
253
254
        Back ->
255
            Back
256
257
        LoadExternalUrl url ->
258
            LoadExternalUrl url
259
260
        SendSharedMsg sharedMsg ->
261
            SendSharedMsg sharedMsg
262
263
        SendToLocalStorage options ->
264
            SendToLocalStorage options
265
266
        SendApiRequest opts ->
267
            SendApiRequest
268
                { endpoint = opts.endpoint
269
                , method = opts.method
270
                , body = opts.body
271
                , decoder = Json.Decode.map fn opts.decoder
272
                , onHttpError = \err -> fn (opts.onHttpError err)
273
                }
274
275
276
{-| Elm Land depends on this function to perform your effects.
277
-}
278
toCmd :
279
    { key : Browser.Navigation.Key
280
    , url : Url
281
    , shared : Shared.Model.Model
282
    , fromSharedMsg : Shared.Msg.Msg -> msg
283
    , batch : List msg -> msg
284
    , toCmd : msg -> Cmd msg
285
    }
286
    -> Effect msg
287
    -> Cmd msg
288
toCmd options effect =
289
    case effect of
290
        None ->
291
            Cmd.none
292
293
        Batch list ->
294
            Cmd.batch (List.map (toCmd options) list)
295
296
        SendCmd cmd ->
297
            cmd
298
299
        PushUrl url ->
300
            Browser.Navigation.pushUrl options.key url
301
302
        ReplaceUrl url ->
303
            Browser.Navigation.replaceUrl options.key url
304
305
        Back ->
306
            Browser.Navigation.back options.key 1
307
308
        LoadExternalUrl url ->
309
            Browser.Navigation.load url
310
311
        SendSharedMsg sharedMsg ->
312
            Task.succeed sharedMsg
313
                |> Task.perform options.fromSharedMsg
314
315
        SendToLocalStorage opts ->
316
            sendToLocalStorage opts
317
318
        SendApiRequest opts ->
319
            let
320
                headers : List Http.Header
321
                headers =
322
                    case options.shared.user of
323
                        Auth.User.SignedIn cred ->
324
                            if not (String.contains opts.endpoint "refresh-tokens") then
325
                                [ Http.header "Authorization" ("Bearer " ++ cred.accessToken) ]
326
327
                            else
328
                                []
329
330
                        _ ->
331
                            []
332
            in
333
            Http.request
334
                { method = opts.method
335
                , url = opts.endpoint
336
                , headers = headers
337
                , body = opts.body
338
                , expect =
339
                    Http.expectStringResponse
340
                        (\httpResult ->
341
                            case httpResult of
342
                                Ok msg ->
343
                                    msg
344
345
                                Err err ->
346
                                    opts.onHttpError err
347
                        )
348
                        (\resp -> fromHttpResponseToCustomError opts.decoder resp)
349
                , timeout = Just (1000 * 60) -- 60 second timeout
350
                , tracker = Nothing
351
                }
352
353
354
fromHttpResponseToCustomError : Json.Decode.Decoder msg -> Http.Response String -> Result Api.Error msg
355
fromHttpResponseToCustomError decoder response =
356
    case response of
357
        Http.GoodStatus_ _ body ->
358
            case
359
                Json.Decode.decodeString decoder
360
                    (if String.isEmpty body then
361
                        "\"\""
362
363
                     else
364
                        body
365
                    )
366
            of
367
                Ok value ->
368
                    Ok value
369
370
                Err err ->
371
                    Err (Api.JsonDecodeError { message = "Failed to decode JSON response", reason = err })
372
373
        Http.BadStatus_ { statusCode } body ->
374
            case Json.Decode.decodeString Data.Error.decode body of
375
                Ok err ->
376
                    Err (Api.HttpError { message = err.message, reason = Http.BadStatus statusCode })
377
378
                Err err ->
379
                    Err (Api.JsonDecodeError { message = "Something unexpected happened", reason = err })
380
381
        Http.BadUrl_ url ->
382
            Err (Api.HttpError { message = "Unexpected URL format", reason = Http.BadUrl url })
383
384
        Http.Timeout_ ->
385
            Err (Api.HttpError { message = "Request timed out, please try again", reason = Http.Timeout })
386
387
        Http.NetworkError_ ->
388
            Err (Api.HttpError { message = "Could not connect, please try again", reason = Http.NetworkError })