1module Application.Application exposing
2    ( Flags
3    , Model
4    , handleCallback
5    , handleDelivery
6    , init
7    , locationMsg
8    , subscriptions
9    , update
10    , view
11    )
12
13import Application.Models exposing (Session)
14import Application.Styles as Styles
15import Browser
16import Concourse
17import EffectTransformer exposing (ET)
18import HoverState
19import Html
20import Html.Attributes exposing (id, style)
21import Http
22import Message.Callback exposing (Callback(..))
23import Message.Effects as Effects exposing (Effect(..))
24import Message.Message as Message
25import Message.Subscription
26    exposing
27        ( Delivery(..)
28        , Interval(..)
29        , Subscription(..)
30        )
31import Message.TopLevelMessage as Msgs exposing (TopLevelMessage(..))
32import RemoteData
33import Routes
34import ScreenSize
35import Set
36import SideBar.SideBar as SideBar
37import SubPage.SubPage as SubPage
38import Time
39import Tooltip
40import Url
41import UserState exposing (UserState(..))
42
43
44type alias Flags =
45    { turbulenceImgSrc : String
46    , notFoundImgSrc : String
47    , csrfToken : Concourse.CSRFToken
48    , authToken : String
49    , pipelineRunningKeyframes : String
50    }
51
52
53type alias Model =
54    { subModel : SubPage.Model
55    , route : Routes.Route
56    , session : Session
57    }
58
59
60init : Flags -> Url.Url -> ( Model, List Effect )
61init flags url =
62    let
63        route =
64            Routes.parsePath url
65                |> Maybe.withDefault
66                    (Routes.Dashboard
67                        { searchType = Routes.Normal ""
68                        , dashboardView = Routes.ViewNonArchivedPipelines
69                        }
70                    )
71
72        session =
73            { userState = UserStateUnknown
74            , hovered = HoverState.NoHover
75            , clusterName = ""
76            , version = ""
77            , turbulenceImgSrc = flags.turbulenceImgSrc
78            , notFoundImgSrc = flags.notFoundImgSrc
79            , csrfToken = flags.csrfToken
80            , authToken = flags.authToken
81            , pipelineRunningKeyframes = flags.pipelineRunningKeyframes
82            , expandedTeamsInAllPipelines = Set.empty
83            , collapsedTeamsInFavorites = Set.empty
84            , pipelines = RemoteData.NotAsked
85            , sideBarState =
86                { isOpen = False
87                , width = 275
88                }
89            , draggingSideBar = False
90            , screenSize = ScreenSize.Desktop
91            , timeZone = Time.utc
92            , favoritedPipelines = Set.empty
93            }
94
95        ( subModel, subEffects ) =
96            SubPage.init session route
97
98        model =
99            { subModel = subModel
100            , session = session
101            , route = route
102            }
103
104        handleTokenEffect =
105            -- We've refreshed on the page and we're not
106            -- getting it from query params
107            if flags.csrfToken == "" then
108                [ LoadToken ]
109
110            else
111                [ SaveToken flags.csrfToken
112                , Effects.ModifyUrl <| Routes.toString route
113                ]
114    in
115    ( model
116    , [ FetchUser
117      , GetScreenSize
118      , LoadSideBarState
119      , LoadFavoritedPipelines
120      , FetchClusterInfo
121      ]
122        ++ handleTokenEffect
123        ++ subEffects
124    )
125
126
127locationMsg : Url.Url -> TopLevelMessage
128locationMsg url =
129    case Routes.parsePath url of
130        Just route ->
131            DeliveryReceived <| RouteChanged route
132
133        Nothing ->
134            Msgs.Callback EmptyCallback
135
136
137handleCallback : Callback -> Model -> ( Model, List Effect )
138handleCallback callback model =
139    case callback of
140        BuildTriggered (Err err) ->
141            redirectToLoginIfNecessary err ( model, [] )
142
143        BuildAborted (Err err) ->
144            redirectToLoginIfNecessary err ( model, [] )
145
146        PausedToggled (Err err) ->
147            redirectToLoginIfNecessary err ( model, [] )
148
149        JobBuildsFetched (Err err) ->
150            redirectToLoginIfNecessary err ( model, [] )
151
152        InputToFetched (Err err) ->
153            redirectToLoginIfNecessary err ( model, [] )
154
155        OutputOfFetched (Err err) ->
156            redirectToLoginIfNecessary err ( model, [] )
157
158        PipelineToggled _ (Err err) ->
159            subpageHandleCallback callback ( model, [] )
160                |> redirectToLoginIfNecessary err
161
162        VisibilityChanged _ _ (Err err) ->
163            subpageHandleCallback callback ( model, [] )
164                |> redirectToLoginIfNecessary err
165
166        LoggedOut (Ok ()) ->
167            let
168                session =
169                    model.session
170
171                newSession =
172                    { session | userState = UserStateLoggedOut }
173            in
174            subpageHandleCallback callback ( { model | session = newSession }, [] )
175
176        AllTeamsFetched (Err err) ->
177            let
178                session =
179                    model.session
180
181                newSession =
182                    { session | userState = UserStateLoggedOut }
183            in
184            subpageHandleCallback callback ( { model | session = newSession }, [] )
185                |> redirectToLoginIfNecessary err
186
187        UserFetched (Ok user) ->
188            let
189                session =
190                    model.session
191
192                newSession =
193                    { session | userState = UserStateLoggedIn user }
194            in
195            subpageHandleCallback callback ( { model | session = newSession }, [] )
196
197        UserFetched (Err _) ->
198            let
199                session =
200                    model.session
201
202                newSession =
203                    { session | userState = UserStateLoggedOut }
204            in
205            subpageHandleCallback callback ( { model | session = newSession }, [] )
206
207        ClusterInfoFetched (Ok { clusterName, version }) ->
208            let
209                session =
210                    model.session
211
212                newSession =
213                    { session | clusterName = clusterName, version = version }
214            in
215            subpageHandleCallback callback ( { model | session = newSession }, [] )
216
217        ScreenResized viewport ->
218            let
219                session =
220                    model.session
221
222                newSession =
223                    { session
224                        | screenSize =
225                            ScreenSize.fromWindowSize viewport.viewport.width
226                    }
227            in
228            subpageHandleCallback
229                callback
230                ( { model | session = newSession }, [] )
231
232        GotCurrentTimeZone zone ->
233            let
234                session =
235                    model.session
236
237                newSession =
238                    { session | timeZone = zone }
239            in
240            ( { model | session = newSession }, [] )
241
242        -- otherwise, pass down
243        _ ->
244            sideBarHandleCallback callback ( model, [] )
245                |> subpageHandleCallback callback
246
247
248sideBarHandleCallback : Callback -> ET Model
249sideBarHandleCallback callback ( model, effects ) =
250    let
251        ( session, newEffects ) =
252            ( model.session, effects )
253                |> (case model.subModel of
254                        SubPage.ResourceModel { resourceIdentifier } ->
255                            SideBar.handleCallback callback <|
256                                RemoteData.Success resourceIdentifier
257
258                        SubPage.PipelineModel { pipelineLocator } ->
259                            SideBar.handleCallback callback <|
260                                RemoteData.Success pipelineLocator
261
262                        SubPage.JobModel { jobIdentifier } ->
263                            SideBar.handleCallback callback <|
264                                RemoteData.Success jobIdentifier
265
266                        SubPage.BuildModel buildModel ->
267                            SideBar.handleCallback callback
268                                (case buildModel.job of
269                                    Just j ->
270                                        RemoteData.Success j
271
272                                    Nothing ->
273                                        RemoteData.NotAsked
274                                )
275
276                        _ ->
277                            SideBar.handleCallback callback <|
278                                RemoteData.NotAsked
279                   )
280                |> Tooltip.handleCallback callback
281    in
282    ( { model | session = session }, newEffects )
283
284
285subpageHandleCallback : Callback -> ET Model
286subpageHandleCallback callback ( model, effects ) =
287    let
288        ( subModel, newEffects ) =
289            ( model.subModel, effects )
290                |> SubPage.handleCallback callback model.session
291                |> SubPage.handleNotFound model.session.notFoundImgSrc model.route
292    in
293    ( { model | subModel = subModel }, newEffects )
294
295
296update : TopLevelMessage -> Model -> ( Model, List Effect )
297update msg model =
298    case msg of
299        Update (Message.Hover hovered) ->
300            let
301                session =
302                    model.session
303
304                newHovered =
305                    case hovered of
306                        Just h ->
307                            HoverState.Hovered h
308
309                        Nothing ->
310                            HoverState.NoHover
311
312                ( newSession, sideBarEffects ) =
313                    { session | hovered = newHovered }
314                        |> SideBar.update (Message.Hover hovered)
315
316                ( subModel, subEffects ) =
317                    ( model.subModel, [] )
318                        |> SubPage.update model.session (Message.Hover hovered)
319            in
320            ( { model | subModel = subModel, session = newSession }
321            , subEffects ++ sideBarEffects
322            )
323
324        Update m ->
325            let
326                ( subModel, subEffects ) =
327                    ( model.subModel, [] )
328                        |> SubPage.update model.session m
329                        |> SubPage.handleNotFound model.session.notFoundImgSrc model.route
330
331                ( session, sessionEffects ) =
332                    SideBar.update m model.session
333            in
334            ( { model | subModel = subModel, session = session }
335            , subEffects ++ sessionEffects
336            )
337
338        Callback callback ->
339            handleCallback callback model
340
341        DeliveryReceived delivery ->
342            handleDelivery delivery model
343
344
345handleDelivery : Delivery -> Model -> ( Model, List Effect )
346handleDelivery delivery model =
347    let
348        ( newSubmodel, subPageEffects ) =
349            ( model.subModel, [] )
350                |> SubPage.handleDelivery model.session delivery
351                |> SubPage.handleNotFound model.session.notFoundImgSrc model.route
352
353        ( newModel, applicationEffects ) =
354            handleDeliveryForApplication
355                delivery
356                { model | subModel = newSubmodel }
357
358        ( newSession, sessionEffects ) =
359            ( newModel.session, [] )
360                |> SideBar.handleDelivery delivery
361    in
362    ( { newModel | session = newSession }, subPageEffects ++ applicationEffects ++ sessionEffects )
363
364
365handleDeliveryForApplication : Delivery -> Model -> ( Model, List Effect )
366handleDeliveryForApplication delivery model =
367    case delivery of
368        NonHrefLinkClicked route ->
369            ( model, [ LoadExternal route ] )
370
371        TokenReceived (Ok tokenValue) ->
372            let
373                session =
374                    model.session
375
376                newSession =
377                    { session | csrfToken = tokenValue }
378            in
379            ( { model | session = newSession }, [] )
380
381        RouteChanged route ->
382            urlUpdate route model
383
384        WindowResized width _ ->
385            let
386                session =
387                    model.session
388
389                newSession =
390                    { session | screenSize = ScreenSize.fromWindowSize width }
391            in
392            ( { model | session = newSession }, [] )
393
394        UrlRequest request ->
395            case request of
396                Browser.Internal url ->
397                    case Routes.parsePath url of
398                        Just route ->
399                            ( model, [ NavigateTo <| Routes.toString route ] )
400
401                        Nothing ->
402                            ( model, [ LoadExternal <| Url.toString url ] )
403
404                Browser.External url ->
405                    ( model, [ LoadExternal url ] )
406
407        _ ->
408            ( model, [] )
409
410
411redirectToLoginIfNecessary : Http.Error -> ET Model
412redirectToLoginIfNecessary err ( model, effects ) =
413    case err of
414        Http.BadStatus { status } ->
415            if status.code == 401 then
416                ( model, effects ++ [ RedirectToLogin ] )
417
418            else
419                ( model, effects )
420
421        _ ->
422            ( model, effects )
423
424
425urlUpdate : Routes.Route -> Model -> ( Model, List Effect )
426urlUpdate route model =
427    let
428        ( newSubmodel, subEffects ) =
429            if route == model.route then
430                ( model.subModel, [] )
431
432            else if routeMatchesModel route model then
433                SubPage.urlUpdate
434                    { from = model.route
435                    , to = route
436                    }
437                    ( model.subModel, [] )
438
439            else
440                SubPage.init model.session route
441    in
442    ( { model | subModel = newSubmodel, route = route }
443    , subEffects ++ [ SetFavIcon Nothing ]
444    )
445
446
447view : Model -> Browser.Document TopLevelMessage
448view model =
449    let
450        ( title, body ) =
451            SubPage.view model.session model.subModel
452    in
453    { title = title ++ " - Concourse"
454    , body =
455        List.map (Html.map Update)
456            [ SubPage.tooltip model.subModel model.session
457                |> Maybe.map (Tooltip.view model.session)
458                |> Maybe.withDefault (Html.text "")
459            , SideBar.tooltip model.session
460                |> Maybe.map (Tooltip.view model.session)
461                |> Maybe.withDefault (Html.text "")
462            , Html.div
463                (id "page-wrapper"
464                    :: style "height" "100%"
465                    :: (if model.session.draggingSideBar then
466                            Styles.disableInteraction
467
468                        else
469                            []
470                       )
471                )
472                [ body ]
473            ]
474    }
475
476
477subscriptions : Model -> List Subscription
478subscriptions model =
479    [ OnNonHrefLinkClicked
480    , OnTokenReceived
481    , OnSideBarStateReceived
482    , OnFavoritedPipelinesReceived
483    , OnWindowResize
484    ]
485        ++ (if model.session.draggingSideBar then
486                [ OnMouse
487                , OnMouseUp
488                ]
489
490            else
491                []
492           )
493        ++ SubPage.subscriptions model.subModel
494
495
496routeMatchesModel : Routes.Route -> Model -> Bool
497routeMatchesModel route model =
498    case ( route, model.subModel ) of
499        ( Routes.Pipeline _, SubPage.PipelineModel _ ) ->
500            True
501
502        ( Routes.Resource _, SubPage.ResourceModel _ ) ->
503            True
504
505        ( Routes.Build _, SubPage.BuildModel _ ) ->
506            True
507
508        ( Routes.OneOffBuild _, SubPage.BuildModel _ ) ->
509            True
510
511        ( Routes.Job _, SubPage.JobModel _ ) ->
512            True
513
514        ( Routes.Dashboard _, SubPage.DashboardModel _ ) ->
515            True
516
517        _ ->
518            False
519