Mirrors/go-inbucket
1
0
Fork 0
mirror of https://github.com/jhillyerd/inbucket.git synced 2025-12-17 17:47:03 +00:00
Code Issues Releases Wiki Activity

Merge branch 'feature/session' into develop

Browse Source
This commit is contained in:
James Hillyerd
2018-12-26 15:44:23 -08:00
parent 6189b56b79 2f7194835d
commit 78b36b0b14
6 changed files with 303 additions and 262 deletions
Download Patch File Download Diff File Expand all files Collapse all files

96
ui/src/Data/Session.elm
View File

@@ -1,13 +1,15 @@
module Data.Session exposing
( Flash
, Msg(..)
, Persistent
, Session
, addRecent
, clearFlash
, decodeValueWithDefault
, decoder
, disableRouting
, enableRouting
, init
, none
, update
, showFlash
)
import Browser.Navigation as Nav
@@ -41,15 +43,6 @@ type alias Persistent =
}
type Msg
= None
| SetFlash Flash
| ClearFlash
| DisableRouting
| EnableRouting
| AddRecent String
init : Nav.Key -> Url -> Persistent -> Session
init key location persistent =
{ key = key
@@ -61,56 +54,43 @@ init key location persistent =
}
update : Msg -> Session -> ( Session, Cmd a )
update msg session =
let
newSession =
case msg of
None ->
session
SetFlash flash ->
{ session | flash = Just flash }
ClearFlash ->
{ session | flash = Nothing }
DisableRouting ->
{ session | routing = False }
EnableRouting ->
{ session | routing = True }
AddRecent mailbox ->
if List.head session.persistent.recentMailboxes == Just mailbox then
session
else
let
recent =
session.persistent.recentMailboxes
|> List.filter ((/=) mailbox)
|> List.take 7
|> (::) mailbox
persistent =
session.persistent
in
{ session | persistent = { persistent | recentMailboxes = recent } }
in
if session.persistent == newSession.persistent then
-- No change
( newSession, Cmd.none )
addRecent : String -> Session -> Session
addRecent mailbox session =
if List.head session.persistent.recentMailboxes == Just mailbox then
session
else
( newSession
, Ports.storeSession (encode newSession.persistent)
)
let
recent =
session.persistent.recentMailboxes
|> List.filter ((/=) mailbox)
|> List.take 7
|> (::) mailbox
persistent =
session.persistent
in
{ session | persistent = { persistent | recentMailboxes = recent } }
none : Msg
none =
None
disableRouting : Session -> Session
disableRouting session =
{ session | routing = False }
enableRouting : Session -> Session
enableRouting session =
{ session | routing = True }
clearFlash : Session -> Session
clearFlash session =
{ session | flash = Nothing }
showFlash : Flash -> Session -> Session
showFlash flash session =
{ session | flash = Just flash }
decoder : D.Decoder Persistent

237
ui/src/Main.elm
View File

@@ -30,7 +30,6 @@ type Page
type alias Model =
{ page : Page
, session : Session
, mailboxName : String
}
@@ -41,12 +40,11 @@ init sessionValue location key =
session =
Session.init key location (Session.decodeValueWithDefault sessionValue)
( subModel, _, _ ) =
Home.init
( subModel, _ ) =
Home.init session
initModel =
{ page = Home subModel
, session = session
, mailboxName = ""
}
@@ -54,7 +52,7 @@ init sessionValue location key =
Route.fromUrl location
( model, cmd ) =
changeRouteTo route initModel |> updateSession
changeRouteTo route initModel
in
( model, Cmd.batch [ cmd, Task.perform TimeZoneLoaded Time.here ] )
@@ -64,9 +62,9 @@ type Msg
| LinkClicked UrlRequest
| SessionUpdated (Result D.Error Session.Persistent)
| TimeZoneLoaded Time.Zone
| ClearFlash
| OnMailboxNameInput String
| ViewMailbox String
| SessionMsg Session.Msg
| HomeMsg Home.Msg
| MailboxMsg Mailbox.Msg
| MonitorMsg Monitor.Msg
@@ -112,157 +110,185 @@ pageSubscriptions page =
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
updateSession <|
case msg of
LinkClicked req ->
case req of
Browser.Internal url ->
case url.fragment of
Just "" ->
-- Anchor tag for accessibility purposes only, already handled.
( model, Cmd.none, Session.none )
let
session =
getSession model
in
case msg of
LinkClicked req ->
case req of
Browser.Internal url ->
case url.fragment of
Just "" ->
-- Anchor tag for accessibility purposes only, already handled.
( model, Cmd.none )
_ ->
( model
, Nav.pushUrl model.session.key (Url.toString url)
, Session.ClearFlash
)
_ ->
( applyToModelSession Session.clearFlash model
, Nav.pushUrl session.key (Url.toString url)
)
Browser.External url ->
( model, Nav.load url, Session.none )
Browser.External url ->
( model, Nav.load url )
UrlChanged url ->
-- Responds to new browser URL.
if model.session.routing then
changeRouteTo (Route.fromUrl url) model
UrlChanged url ->
-- Responds to new browser URL.
if session.routing then
changeRouteTo (Route.fromUrl url) model
else
-- Skip once, but re-enable routing.
( model, Cmd.none, Session.EnableRouting )
SessionMsg sessionMsg ->
( model, Cmd.none, sessionMsg )
SessionUpdated (Ok persistent) ->
let
session =
model.session
in
( { model | session = { session | persistent = persistent } }
else
-- Skip once, but re-enable routing.
( applyToModelSession Session.enableRouting model
, Cmd.none
, Session.none
)
SessionUpdated (Err error) ->
( model
, Cmd.none
, Session.SetFlash
ClearFlash ->
( applyToModelSession Session.clearFlash model
, Cmd.none
)
SessionUpdated (Ok persistent) ->
( updateSession model { session | persistent = persistent }
, Cmd.none
)
SessionUpdated (Err error) ->
let
flash =
{ title = "Error decoding session"
, table = [ ( "Error", D.errorToString error ) ]
}
)
in
( applyToModelSession (Session.showFlash flash) model
, Cmd.none
)
TimeZoneLoaded zone ->
let
session =
model.session
in
( { model | session = { session | zone = zone } }
, Cmd.none
, Session.none
)
TimeZoneLoaded zone ->
( updateSession model { session | zone = zone }
, Cmd.none
)
OnMailboxNameInput name ->
( { model | mailboxName = name }, Cmd.none, Session.none )
OnMailboxNameInput name ->
( { model | mailboxName = name }, Cmd.none )
ViewMailbox name ->
( { model | mailboxName = "" }
, Route.pushUrl model.session.key (Route.Mailbox name)
, Session.ClearFlash
)
ViewMailbox name ->
( applyToModelSession Session.clearFlash { model | mailboxName = "" }
, Route.pushUrl session.key (Route.Mailbox name)
)
_ ->
updatePage msg model
_ ->
updatePage msg model
{-| Delegates incoming messages to their respective sub-pages.
-}
updatePage : Msg -> Model -> ( Model, Cmd Msg, Session.Msg )
updatePage : Msg -> Model -> ( Model, Cmd Msg )
updatePage msg model =
case ( msg, model.page ) of
( HomeMsg subMsg, Home subModel ) ->
Home.update model.session subMsg subModel
Home.update subMsg subModel
|> updateWith Home HomeMsg model
( MailboxMsg subMsg, Mailbox subModel ) ->
Mailbox.update model.session subMsg subModel
Mailbox.update subMsg subModel
|> updateWith Mailbox MailboxMsg model
( MonitorMsg subMsg, Monitor subModel ) ->
Monitor.update model.session subMsg subModel
Monitor.update subMsg subModel
|> updateWith Monitor MonitorMsg model
( StatusMsg subMsg, Status subModel ) ->
Status.update model.session subMsg subModel
Status.update subMsg subModel
|> updateWith Status StatusMsg model
( _, _ ) ->
-- Disregard messages destined for the wrong page.
( model, Cmd.none, Session.none )
( model, Cmd.none )
changeRouteTo : Route -> Model -> ( Model, Cmd Msg, Session.Msg )
changeRouteTo : Route -> Model -> ( Model, Cmd Msg )
changeRouteTo route model =
let
( newModel, newCmd, newSession ) =
session =
getSession model
( newModel, newCmd ) =
case route of
Route.Unknown path ->
( model
let
flash =
{ title = "Unknown route requested"
, table = [ ( "Path", path ) ]
}
in
( applyToModelSession (Session.showFlash flash) model
, Cmd.none
, Session.SetFlash
{ title = "Unknown route requested"
, table = [ ( "Path", path ) ]
}
)
Route.Home ->
Home.init
Home.init session
|> updateWith Home HomeMsg model
Route.Mailbox name ->
Mailbox.init name Nothing
Mailbox.init session name Nothing
|> updateWith Mailbox MailboxMsg model
Route.Message mailbox id ->
Mailbox.init mailbox (Just id)
Mailbox.init session mailbox (Just id)
|> updateWith Mailbox MailboxMsg model
Route.Monitor ->
Monitor.init
Monitor.init session
|> updateWith Monitor MonitorMsg model
Route.Status ->
Status.init
Status.init session
|> updateWith Status StatusMsg model
in
case model.page of
Monitor _ ->
-- Leaving Monitor page, shut down the web socket.
( newModel, Cmd.batch [ Ports.monitorCommand False, newCmd ], newSession )
( newModel, Cmd.batch [ Ports.monitorCommand False, newCmd ] )
_ ->
( newModel, newCmd, newSession )
( newModel, newCmd )
updateSession : ( Model, Cmd Msg, Session.Msg ) -> ( Model, Cmd Msg )
updateSession ( model, cmd, sessionMsg ) =
let
( session, newCmd ) =
Session.update sessionMsg model.session
in
( { model | session = session }
, Cmd.batch [ newCmd, cmd ]
)
getSession : Model -> Session
getSession model =
case model.page of
Home subModel ->
subModel.session
Mailbox subModel ->
subModel.session
Monitor subModel ->
subModel.session
Status subModel ->
subModel.session
updateSession : Model -> Session -> Model
updateSession model session =
case model.page of
Home subModel ->
{ model | page = Home { subModel | session = session } }
Mailbox subModel ->
{ model | page = Mailbox { subModel | session = session } }
Monitor subModel ->
{ model | page = Monitor { subModel | session = session } }
Status subModel ->
{ model | page = Status { subModel | session = session } }
applyToModelSession : (Session -> Session) -> Model -> Model
applyToModelSession f model =
updateSession model (f (getSession model))
{-| Map page updates to Main Model and Msg types.
@@ -271,12 +297,11 @@ updateWith :
(subModel -> Page)
-> (subMsg -> Msg)
-> Model
-> ( subModel, Cmd subMsg, Session.Msg )
-> ( Model, Cmd Msg, Session.Msg )
updateWith toPage toMsg model ( subModel, subCmd, sessionMsg ) =
-> ( subModel, Cmd subMsg )
-> ( Model, Cmd Msg )
updateWith toPage toMsg model ( subModel, subCmd ) =
( { model | page = toPage subModel }
, Cmd.map toMsg subCmd
, sessionMsg
)
@@ -287,6 +312,9 @@ updateWith toPage toMsg model ( subModel, subCmd, sessionMsg ) =
view : Model -> Document Msg
view model =
let
session =
getSession model
mailbox =
case model.page of
Mailbox subModel ->
@@ -299,9 +327,9 @@ view model =
{ viewMailbox = ViewMailbox
, mailboxOnInput = OnMailboxNameInput
, mailboxValue = model.mailboxName
, recentOptions = model.session.persistent.recentMailboxes
, recentOptions = session.persistent.recentMailboxes
, recentActive = mailbox
, clearFlash = SessionMsg Session.ClearFlash
, clearFlash = ClearFlash
}
framePage :
@@ -311,8 +339,9 @@ view model =
-> Document Msg
framePage page toMsg { title, modal, content } =
Document title
[ Page.frame controls
model.session
[ Page.frame
controls
session
page
(Maybe.map (Html.map toMsg) modal)
(List.map (Html.map toMsg) content)
@@ -320,16 +349,16 @@ view model =
in
case model.page of
Home subModel ->
framePage Page.Other HomeMsg (Home.view model.session subModel)
framePage Page.Other HomeMsg (Home.view subModel)
Mailbox subModel ->
framePage Page.Mailbox MailboxMsg (Mailbox.view model.session subModel)
framePage Page.Mailbox MailboxMsg (Mailbox.view subModel)
Monitor subModel ->
framePage Page.Monitor MonitorMsg (Monitor.view model.session subModel)
framePage Page.Monitor MonitorMsg (Monitor.view subModel)
Status subModel ->
framePage Page.Status StatusMsg (Status.view model.session subModel)
framePage Page.Status StatusMsg (Status.view subModel)

24
ui/src/Page/Home.elm
View File

@@ -15,12 +15,14 @@ import Ports
type alias Model =
{ greeting : String }
{ session : Session
, greeting : String
}
init : ( Model, Cmd Msg, Session.Msg )
init =
( Model "", Api.getGreeting GreetingLoaded, Session.none )
init : Session -> ( Model, Cmd Msg )
init session =
( Model session "", Api.getGreeting GreetingLoaded )
@@ -31,22 +33,24 @@ type Msg
= GreetingLoaded (Result HttpUtil.Error String)
update : Session -> Msg -> Model -> ( Model, Cmd Msg, Session.Msg )
update session msg model =
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
GreetingLoaded (Ok greeting) ->
( Model greeting, Cmd.none, Session.none )
( { model | greeting = greeting }, Cmd.none )
GreetingLoaded (Err err) ->
( model, Cmd.none, Session.SetFlash (HttpUtil.errorFlash err) )
( { model | session = Session.showFlash (HttpUtil.errorFlash err) model.session }
, Cmd.none
)
-- VIEW --
view : Session -> Model -> { title : String, modal : Maybe (Html msg), content : List (Html Msg) }
view session model =
view : Model -> { title : String, modal : Maybe (Html msg), content : List (Html Msg) }
view model =
{ title = "Inbucket"
, modal = Nothing
, content =

135
ui/src/Page/Mailbox.elm
View File

@@ -71,7 +71,8 @@ type alias VisibleMessage =
type alias Model =
{ mailboxName : String
{ session : Session
, mailboxName : String
, state : State
, bodyMode : Body
, searchInput : String
@@ -80,11 +81,17 @@ type alias Model =
}
init : String -> Maybe MessageID -> ( Model, Cmd Msg, Session.Msg )
init mailboxName selection =
( Model mailboxName (LoadingList selection) SafeHtmlBody "" False (Time.millisToPosix 0)
init : Session -> String -> Maybe MessageID -> ( Model, Cmd Msg )
init session mailboxName selection =
( { session = session
, mailboxName = mailboxName
, state = LoadingList selection
, bodyMode = SafeHtmlBody
, searchInput = ""
, promptPurge = False
, now = Time.millisToPosix 0
}
, load mailboxName
, Session.none
)
@@ -144,30 +151,31 @@ type Msg
| Tick Posix
update : Session -> Msg -> Model -> ( Model, Cmd Msg, Session.Msg )
update session msg model =
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
ClickMessage id ->
( updateSelected model id
( updateSelected { model | session = Session.disableRouting model.session } id
, Cmd.batch
[ -- Update browser location.
Route.replaceUrl session.key (Route.Message model.mailboxName id)
Route.replaceUrl model.session.key (Route.Message model.mailboxName id)
, Api.getMessage MessageLoaded model.mailboxName id
]
, Session.DisableRouting
)
OpenMessage id ->
updateOpenMessage session model id
updateOpenMessage model.session model id
DeleteMessage message ->
updateDeleteMessage session model message
updateDeleteMessage model.session model message
DeletedMessage (Ok _) ->
( model, Cmd.none, Session.none )
( model, Cmd.none )
DeletedMessage (Err err) ->
( model, Cmd.none, Session.SetFlash (HttpUtil.errorFlash err) )
( { model | session = Session.showFlash (HttpUtil.errorFlash err) model.session }
, Cmd.none
)
ListLoaded (Ok headers) ->
case model.state of
@@ -180,31 +188,41 @@ update session msg model =
in
case selection of
Just id ->
updateOpenMessage session newModel id
updateOpenMessage model.session newModel id
Nothing ->
( newModel, Cmd.none, Session.AddRecent model.mailboxName )
( { newModel
| session = Session.addRecent model.mailboxName model.session
}
, Cmd.none
)
_ ->
( model, Cmd.none, Session.none )
( model, Cmd.none )
ListLoaded (Err err) ->
( model, Cmd.none, Session.SetFlash (HttpUtil.errorFlash err) )
( { model | session = Session.showFlash (HttpUtil.errorFlash err) model.session }
, Cmd.none
)
MarkedSeen (Ok _) ->
( model, Cmd.none, Session.none )
( model, Cmd.none )
MarkedSeen (Err err) ->
( model, Cmd.none, Session.SetFlash (HttpUtil.errorFlash err) )
( { model | session = Session.showFlash (HttpUtil.errorFlash err) model.session }
, Cmd.none
)
MessageLoaded (Ok message) ->
updateMessageResult model message
MessageLoaded (Err err) ->
( model, Cmd.none, Session.SetFlash (HttpUtil.errorFlash err) )
( { model | session = Session.showFlash (HttpUtil.errorFlash err) model.session }
, Cmd.none
)
MessageBody bodyMode ->
( { model | bodyMode = bodyMode }, Cmd.none, Session.none )
( { model | bodyMode = bodyMode }, Cmd.none )
OnSearchInput searchInput ->
updateSearchInput model searchInput
@@ -213,7 +231,7 @@ update session msg model =
case model.state of
ShowingList list (ShowingMessage visible) ->
if visible.message.seen then
( model, Cmd.none, Session.none )
( model, Cmd.none )
else
-- Set 1500ms delay before reporting message as seen to backend.
@@ -231,26 +249,27 @@ update session msg model =
)
}
, Cmd.none
, Session.none
)
_ ->
( model, Cmd.none, Session.none )
( model, Cmd.none )
PurgeMailboxPrompt ->
( { model | promptPurge = True }, Cmd.none, Session.none )
( { model | promptPurge = True }, Cmd.none )
PurgeMailboxCanceled ->
( { model | promptPurge = False }, Cmd.none, Session.none )
( { model | promptPurge = False }, Cmd.none )
PurgeMailboxConfirmed ->
updatePurge session model
updatePurge model.session model
PurgedMailbox (Ok _) ->
( model, Cmd.none, Session.none )
( model, Cmd.none )
PurgedMailbox (Err err) ->
( model, Cmd.none, Session.SetFlash (HttpUtil.errorFlash err) )
( { model | session = Session.showFlash (HttpUtil.errorFlash err) model.session }
, Cmd.none
)
MarkSeenTick now ->
case model.state of
@@ -261,21 +280,21 @@ update session msg model =
updateMarkMessageSeen model message
else
( model, Cmd.none, Session.none )
( model, Cmd.none )
Nothing ->
( model, Cmd.none, Session.none )
( model, Cmd.none )
_ ->
( model, Cmd.none, Session.none )
( model, Cmd.none )
Tick now ->
( { model | now = now }, Cmd.none, Session.none )
( { model | now = now }, Cmd.none )
{-| Replace the currently displayed message.
-}
updateMessageResult : Model -> Message -> ( Model, Cmd Msg, Session.Msg )
updateMessageResult : Model -> Message -> ( Model, Cmd Msg )
updateMessageResult model message =
let
bodyMode =
@@ -287,7 +306,7 @@ updateMessageResult model message =
in
case model.state of
LoadingList _ ->
( model, Cmd.none, Session.none )
( model, Cmd.none )
ShowingList list _ ->
( { model
@@ -298,11 +317,10 @@ updateMessageResult model message =
, bodyMode = bodyMode
}
, Task.perform OpenedTime Time.now
, Session.none
)
updatePurge : Session -> Model -> ( Model, Cmd Msg, Session.Msg )
updatePurge : Session -> Model -> ( Model, Cmd Msg )
updatePurge session model =
let
cmd =
@@ -315,17 +333,17 @@ updatePurge session model =
ShowingList list _ ->
( { model
| promptPurge = False
, session = Session.disableRouting model.session
, state = ShowingList (MessageList [] Nothing "") NoMessage
}
, cmd
, Session.DisableRouting
)
_ ->
( model, cmd, Session.none )
( model, cmd )
updateSearchInput : Model -> String -> ( Model, Cmd Msg, Session.Msg )
updateSearchInput : Model -> String -> ( Model, Cmd Msg )
updateSearchInput model searchInput =
let
searchFilter =
@@ -337,7 +355,7 @@ updateSearchInput model searchInput =
in
case model.state of
LoadingList _ ->
( model, Cmd.none, Session.none )
( model, Cmd.none )
ShowingList list messageState ->
( { model
@@ -345,7 +363,6 @@ updateSearchInput model searchInput =
, state = ShowingList { list | searchFilter = searchFilter } messageState
}
, Cmd.none
, Session.none
)
@@ -377,7 +394,7 @@ updateSelected model id =
{ model | state = ShowingList newList (Transitioning visible) }
updateDeleteMessage : Session -> Model -> Message -> ( Model, Cmd Msg, Session.Msg )
updateDeleteMessage : Session -> Model -> Message -> ( Model, Cmd Msg )
updateDeleteMessage session model message =
let
filter f messageList =
@@ -386,21 +403,21 @@ updateDeleteMessage session model message =
case model.state of
ShowingList list _ ->
( { model
| state =
| session = Session.disableRouting model.session
, state =
ShowingList (filter (\x -> x.id /= message.id) list) NoMessage
}
, Cmd.batch
[ Api.deleteMessage DeletedMessage message.mailbox message.id
, Route.replaceUrl session.key (Route.Mailbox model.mailboxName)
]
, Session.DisableRouting
)
_ ->
( model, Cmd.none, Session.none )
( model, Cmd.none )
updateMarkMessageSeen : Model -> Message -> ( Model, Cmd Msg, Session.Msg )
updateMarkMessageSeen : Model -> Message -> ( Model, Cmd Msg )
updateMarkMessageSeen model message =
case model.state of
ShowingList list (ShowingMessage visible) ->
@@ -426,18 +443,20 @@ updateMarkMessageSeen model message =
)
}
, Api.markMessageSeen MarkedSeen message.mailbox message.id
, Session.None
)
_ ->
( model, Cmd.none, Session.none )
( model, Cmd.none )
updateOpenMessage : Session -> Model -> String -> ( Model, Cmd Msg, Session.Msg )
updateOpenMessage : Session -> Model -> String -> ( Model, Cmd Msg )
updateOpenMessage session model id =
( updateSelected model id
let
newModel =
{ model | session = Session.addRecent model.mailboxName model.session }
in
( updateSelected newModel id
, Api.getMessage MessageLoaded model.mailboxName id
, Session.AddRecent model.mailboxName
)
@@ -445,8 +464,8 @@ updateOpenMessage session model id =
-- VIEW
view : Session -> Model -> { title : String, modal : Maybe (Html Msg), content : List (Html Msg) }
view session model =
view : Model -> { title : String, modal : Maybe (Html Msg), content : List (Html Msg) }
view model =
{ title = model.mailboxName ++ " - Inbucket"
, modal = viewModal model.promptPurge
, content =
@@ -465,7 +484,7 @@ view session model =
]
[ i [ class "fas fa-trash" ] [] ]
]
, viewMessageList session model
, viewMessageList model.session model
, main_
[ class "message" ]
[ case model.state of
@@ -476,10 +495,10 @@ view session model =
)
ShowingList _ (ShowingMessage { message }) ->
viewMessage session.zone message model.bodyMode
viewMessage model.session.zone message model.bodyMode
ShowingList _ (Transitioning { message }) ->
viewMessage session.zone message model.bodyMode
viewMessage model.session.zone message model.bodyMode
_ ->
text ""

40
ui/src/Page/Monitor.elm
View File

@@ -17,7 +17,8 @@ import Time exposing (Posix)
type alias Model =
{ connected : Bool
{ session : Session
, connected : Bool
, messages : List MessageHeader
}
@@ -27,9 +28,11 @@ type MonitorMessage
| Message MessageHeader
init : ( Model, Cmd Msg, Session.Msg )
init =
( Model False [], Ports.monitorCommand True, Session.none )
init : Session -> ( Model, Cmd Msg )
init session =
( Model session False []
, Ports.monitorCommand True
)
@@ -59,28 +62,29 @@ type Msg
| OpenMessage MessageHeader
update : Session -> Msg -> Model -> ( Model, Cmd Msg, Session.Msg )
update session msg model =
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
MessageReceived (Ok (Connected status)) ->
( { model | connected = status }, Cmd.none, Session.none )
( { model | connected = status }, Cmd.none )
MessageReceived (Ok (Message header)) ->
( { model | messages = header :: model.messages }, Cmd.none, Session.none )
( { model | messages = header :: model.messages }, Cmd.none )
MessageReceived (Err err) ->
( model
let
flash =
{ title = "Decoding failed"
, table = [ ( "Error", D.errorToString err ) ]
}
in
( { model | session = Session.showFlash flash model.session }
, Cmd.none
, Session.SetFlash
{ title = "Decoding failed"
, table = [ ( "Error", D.errorToString err ) ]
}
)
OpenMessage header ->
( model
, Route.pushUrl session.key (Route.Message header.mailbox header.id)
, Session.none
, Route.pushUrl model.session.key (Route.Message header.mailbox header.id)
)
@@ -88,8 +92,8 @@ update session msg model =
-- VIEW
view : Session -> Model -> { title : String, modal : Maybe (Html msg), content : List (Html Msg) }
view session model =
view : Model -> { title : String, modal : Maybe (Html msg), content : List (Html Msg) }
view model =
{ title = "Inbucket Monitor"
, modal = Nothing
, content =
@@ -113,7 +117,7 @@ view session model =
, th [] [ text "Mailbox" ]
, th [] [ text "Subject" ]
]
, tbody [] (List.map (viewMessage session.zone) model.messages)
, tbody [] (List.map (viewMessage model.session.zone) model.messages)
]
]
}

33
ui/src/Page/Status.elm
View File

@@ -21,7 +21,8 @@ import Time exposing (Posix)
type alias Model =
{ now : Posix
{ session : Session
, now : Posix
, config : Maybe ServerConfig
, metrics : Maybe Metrics
, xCounter : Float
@@ -52,9 +53,10 @@ type alias Metric =
}
init : ( Model, Cmd Msg, Session.Msg )
init =
( { now = Time.millisToPosix 0
init : Session -> ( Model, Cmd Msg )
init session =
( { session = session
, now = Time.millisToPosix 0
, config = Nothing
, metrics = Nothing
, xCounter = 60
@@ -77,7 +79,6 @@ init =
[ Task.perform Tick Time.now
, Api.getServerConfig ServerConfigLoaded
]
, Session.none
)
@@ -106,23 +107,27 @@ type Msg
| Tick Posix
update : Session -> Msg -> Model -> ( Model, Cmd Msg, Session.Msg )
update session msg model =
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
MetricsReceived (Ok metrics) ->
( updateMetrics metrics model, Cmd.none, Session.none )
( updateMetrics metrics model, Cmd.none )
MetricsReceived (Err err) ->
( model, Cmd.none, Session.SetFlash (HttpUtil.errorFlash err) )
( { model | session = Session.showFlash (HttpUtil.errorFlash err) model.session }
, Cmd.none
)
ServerConfigLoaded (Ok config) ->
( { model | config = Just config }, Cmd.none, Session.none )
( { model | config = Just config }, Cmd.none )
ServerConfigLoaded (Err err) ->
( model, Cmd.none, Session.SetFlash (HttpUtil.errorFlash err) )
( { model | session = Session.showFlash (HttpUtil.errorFlash err) model.session }
, Cmd.none
)
Tick time ->
( { model | now = time }, Api.getServerMetrics MetricsReceived, Session.none )
( { model | now = time }, Api.getServerMetrics MetricsReceived )
{-| Update all metrics in Model; increment xCounter.
@@ -225,8 +230,8 @@ updateRemoteTotal metric value history =
-- VIEW --
view : Session -> Model -> { title : String, modal : Maybe (Html msg), content : List (Html Msg) }
view session model =
view : Model -> { title : String, modal : Maybe (Html msg), content : List (Html Msg) }
view model =
{ title = "Inbucket Status"
, modal = Nothing
, content =