Add configurable base path for reverse proxy use (#169)

* ui: Refactor routing functions into Router record
* ui: Store base URI in AppConfig
* ui: Use basePath in Router functions
* backend: Add Web.BasePath config option and update routes
* Tweaks to get SPA to bootstrap basePath configured
* ui: basePath support for apis/serve
* ui: basePath support for message monitor
* web: Redirect requests to / when basePath configured
* doc: add basepath to config.md
* Closes #107

ui/src/Page/Home.elm

@@ -20,7 +20,7 @@ type alias Model =
 
 init : Session -> ( Model, Cmd Msg )
 init session =
-    ( Model session "", Api.getGreeting GreetingLoaded )
+    ( Model session "", Api.getGreeting session GreetingLoaded )
 
 
 

ui/src/Page/Mailbox.elm

@@ -1,6 +1,7 @@
 module Page.Mailbox exposing (Model, Msg, init, load, subscriptions, update, view)
 
 import Api
+import Browser.Navigation as Nav
 import Data.Message as Message exposing (Message)
 import Data.MessageHeader exposing (MessageHeader)
 import Data.Session as Session exposing (Session)
@@ -113,15 +114,15 @@ init session mailboxName selection =
       , markSeenTimer = Timer.empty
       , now = Time.millisToPosix 0
       }
-    , load mailboxName
+    , load session mailboxName
     )
 
 
-load : String -> Cmd Msg
-load mailboxName =
+load : Session -> String -> Cmd Msg
+load session mailboxName =
     Cmd.batch
         [ Task.perform Tick Time.now
-        , Api.getHeaderList ListLoaded mailboxName
+        , Api.getHeaderList session ListLoaded mailboxName
         ]
 
 
@@ -165,8 +166,10 @@ update msg model =
             ( updateSelected { model | session = Session.disableRouting model.session } id
             , Cmd.batch
                 [ -- Update browser location.
-                  Route.replaceUrl model.session.key (Route.Message model.mailboxName id)
-                , Api.getMessage MessageLoaded model.mailboxName id
+                  Route.Message model.mailboxName id
+                    |> model.session.router.toPath
+                    |> Nav.replaceUrl model.session.key
+                , Api.getMessage model.session MessageLoaded model.mailboxName id
                 ]
             )
 
@@ -322,8 +325,10 @@ updateTriggerPurge model =
     let
         cmd =
             Cmd.batch
-                [ Route.replaceUrl model.session.key (Route.Mailbox model.mailboxName)
-                , Api.purgeMailbox PurgedMailbox model.mailboxName
+                [ Route.Mailbox model.mailboxName
+                    |> model.session.router.toPath
+                    |> Nav.replaceUrl model.session.key
+                , Api.purgeMailbox model.session PurgedMailbox model.mailboxName
                 ]
     in
     case model.state of
@@ -405,8 +410,10 @@ updateDeleteMessage model message =
                     ShowingList (filter (\x -> x.id /= message.id) list) NoMessage
               }
             , Cmd.batch
-                [ Api.deleteMessage DeletedMessage message.mailbox message.id
-                , Route.replaceUrl model.session.key (Route.Mailbox model.mailboxName)
+                [ Api.deleteMessage model.session DeletedMessage message.mailbox message.id
+                , Route.Mailbox model.mailboxName
+                    |> model.session.router.toPath
+                    |> Nav.replaceUrl model.session.key
                 ]
             )
 
@@ -435,7 +442,7 @@ updateMarkMessageSeen model =
                 | state =
                     ShowingList newMessages (ShowingMessage { visibleMessage | seen = True })
               }
-            , Api.markMessageSeen MarkSeenLoaded visibleMessage.mailbox visibleMessage.id
+            , Api.markMessageSeen model.session MarkSeenLoaded visibleMessage.mailbox visibleMessage.id
             )
 
         _ ->
@@ -449,7 +456,7 @@ updateOpenMessage model id =
             { model | session = Session.addRecent model.mailboxName model.session }
     in
     ( updateSelected newModel id
-    , Api.getMessage MessageLoaded model.mailboxName id
+    , Api.getMessage model.session MessageLoaded model.mailboxName id
     )
 
 
@@ -503,10 +510,10 @@ view model =
                             )
 
                     ShowingList _ (ShowingMessage message) ->
-                        viewMessage model.session.zone message model.bodyMode
+                        viewMessage model.session model.session.zone message model.bodyMode
 
                     ShowingList _ (Transitioning message) ->
-                        viewMessage model.session.zone message model.bodyMode
+                        viewMessage model.session model.session.zone message model.bodyMode
 
                     _ ->
                         text ""
@@ -564,14 +571,14 @@ messageChip model selected message =
         ]
 
 
-viewMessage : Time.Zone -> Message -> Body -> Html Msg
-viewMessage zone message bodyMode =
+viewMessage : Session -> Time.Zone -> Message -> Body -> Html Msg
+viewMessage session zone message bodyMode =
     let
         htmlUrl =
-            Api.serveUrl [ "mailbox", message.mailbox, message.id, "html" ]
+            Api.serveUrl session [ "mailbox", message.mailbox, message.id, "html" ]
 
         sourceUrl =
-            Api.serveUrl [ "mailbox", message.mailbox, message.id, "source" ]
+            Api.serveUrl session [ "mailbox", message.mailbox, message.id, "source" ]
 
         htmlButton =
             if message.html == "" then
@@ -602,7 +609,7 @@ viewMessage zone message bodyMode =
             ]
         , messageErrors message
         , messageBody message bodyMode
-        , attachments message
+        , attachments session message
         ]
 
 
@@ -665,20 +672,20 @@ messageBody message bodyMode =
         ]
 
 
-attachments : Message -> Html Msg
-attachments message =
+attachments : Session -> Message -> Html Msg
+attachments session message =
     if List.isEmpty message.attachments then
         div [] []
 
     else
-        table [ class "attachments well" ] (List.map (attachmentRow message) message.attachments)
+        table [ class "attachments well" ] (List.map (attachmentRow session message) message.attachments)
 
 
-attachmentRow : Message -> Message.Attachment -> Html Msg
-attachmentRow message attach =
+attachmentRow : Session -> Message -> Message.Attachment -> Html Msg
+attachmentRow session message attach =
     let
         url =
-            Api.serveUrl
+            Api.serveUrl session
                 [ "mailbox"
                 , message.mailbox
                 , message.id

ui/src/Page/Monitor.elm

@@ -1,5 +1,7 @@
 module Page.Monitor exposing (Model, Msg, init, update, view)
 
+import Api
+import Browser.Navigation as Nav
 import Data.MessageHeader as MessageHeader exposing (MessageHeader)
 import Data.Session as Session exposing (Session)
 import DateFormat as DF
@@ -21,7 +23,7 @@ import Html
         , thead
         , tr
         )
-import Html.Attributes exposing (class, tabindex)
+import Html.Attributes exposing (class, src, tabindex)
 import Html.Events as Events
 import Json.Decode as D
 import Route
@@ -101,7 +103,9 @@ update msg model =
 openMessage : MessageHeader -> Model -> ( Model, Cmd Msg )
 openMessage header model =
     ( model
-    , Route.pushUrl model.session.key (Route.Message header.mailbox header.id)
+    , Route.Message header.mailbox header.id
+        |> model.session.router.toPath
+        |> Nav.replaceUrl model.session.key
     )
 
 
@@ -132,8 +136,12 @@ view model =
                 [ button [ Events.onClick Clear ] [ text "Clear" ]
                 ]
             ]
+
+        -- monitor-messages maintains a websocket connection to the Inbucket daemon at the path
+        -- specified by `src`.
         , node "monitor-messages"
-            [ Events.on "connected" (D.map Connected <| D.at [ "detail" ] <| D.bool)
+            [ src (Api.monitorUri model.session)
+            , Events.on "connected" (D.map Connected <| D.at [ "detail" ] <| D.bool)
             , Events.on "message" (D.map MessageReceived D.value)
             ]
             []

ui/src/Page/Status.elm

@@ -84,7 +84,7 @@ init session =
       }
     , Cmd.batch
         [ Task.perform Tick Time.now
-        , Api.getServerConfig ServerConfigLoaded
+        , Api.getServerConfig session ServerConfigLoaded
         ]
     )
 
@@ -134,7 +134,7 @@ update msg model =
             )
 
         Tick time ->
-            ( { model | now = time }, Api.getServerMetrics MetricsReceived )
+            ( { model | now = time }, Api.getServerMetrics model.session MetricsReceived )
 
 
 {-| Update all metrics in Model; increment xCounter.