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