ui: Much elm work, such wow

- ui: Fix favicon
- webui: Changes to support serving Elm UI
- Static files now served from `/` mount point.
- Old UI handlers moved to `/serve` mount point, some will still be
  needed by the Elm UI; safe HTML and attachments for example.
- Update dev-start.sh for new UI, with tip on how to build it.
- ui: Detect browser host:port for websocket URL,
- webui: Remove unused mailbox handlers, rename routes
- Many routes not needed by Elm UI.
- `/serve/mailbox/*` becomes `/serve/m/*`.
- webui: Impl custom JSON message API for web UI,
- ui: Refactor Mailbox view functions,
- ui: Add body tabs for safe HTML and plain text,
- webui: Format plain text for new UI,
- ui: List attachments with view & download links,

ui/src/Page/Mailbox.elm

@@ -5,21 +5,21 @@ import Data.MessageHeader as MessageHeader exposing (MessageHeader)
 import Data.Session as Session exposing (Session)
 import Json.Decode as Decode exposing (Decoder)
 import Html exposing (..)
-import Html.Attributes exposing (class, classList, href, id, placeholder, target)
+import Html.Attributes exposing (class, classList, downloadAs, href, id, property, target)
 import Html.Events exposing (..)
 import Http exposing (Error)
 import HttpUtil
+import Json.Encode exposing (string)
 import Ports
 import Route exposing (Route)
 
 
-inbucketBase : String
-inbucketBase =
-    ""
+-- MODEL
 
 
-
--- MODEL --
+type Body
+    = TextBody
+    | SafeHtmlBody
 
 
 type alias Model =
@@ -27,12 +27,13 @@ type alias Model =
     , selected : Maybe String
     , headers : List MessageHeader
     , message : Maybe Message
+    , bodyMode : Body
     }
 
 
 init : String -> Maybe String -> Model
 init name id =
-    Model name id [] Nothing
+    Model name id [] Nothing SafeHtmlBody
 
 
 load : String -> Cmd Msg
@@ -44,7 +45,7 @@ load name =
 
 
 
--- UPDATE --
+-- UPDATE
 
 
 type Msg
@@ -52,8 +53,9 @@ type Msg
     | ViewMessage String
     | DeleteMessage Message
     | DeleteMessageResult (Result Http.Error ())
-    | NewMailbox (Result Http.Error (List MessageHeader))
-    | NewMessage (Result Http.Error Message)
+    | MailboxResult (Result Http.Error (List MessageHeader))
+    | MessageResult (Result Http.Error Message)
+    | MessageBody Body
 
 
 update : Session -> Msg -> Model -> ( Model, Cmd Msg, Session.Msg )
@@ -83,7 +85,7 @@ update session msg model =
         DeleteMessageResult (Err err) ->
             ( model, Cmd.none, Session.SetFlash (HttpUtil.errorString err) )
 
-        NewMailbox (Ok headers) ->
+        MailboxResult (Ok headers) ->
             let
                 newModel =
                     { model | headers = headers }
@@ -96,31 +98,47 @@ update session msg model =
                         -- Recurse to select message id.
                         update session (ViewMessage id) newModel
 
-        NewMailbox (Err err) ->
+        MailboxResult (Err err) ->
             ( model, Cmd.none, Session.SetFlash (HttpUtil.errorString err) )
 
-        NewMessage (Ok msg) ->
-            ( { model | message = Just msg }, Cmd.none, Session.none )
+        MessageResult (Ok msg) ->
+            let
+                bodyMode =
+                    if msg.html == "" then
+                        TextBody
+                    else
+                        model.bodyMode
+            in
+                ( { model
+                    | message = Just msg
+                    , bodyMode = bodyMode
+                  }
+                , Cmd.none
+                , Session.none
+                )
 
-        NewMessage (Err err) ->
+        MessageResult (Err err) ->
             ( model, Cmd.none, Session.SetFlash (HttpUtil.errorString err) )
 
+        MessageBody bodyMode ->
+            ( { model | bodyMode = bodyMode }, Cmd.none, Session.none )
+
 
 getMailbox : String -> Cmd Msg
 getMailbox name =
     let
         url =
-            inbucketBase ++ "/api/v1/mailbox/" ++ name
+            "/api/v1/mailbox/" ++ name
     in
         Http.get url (Decode.list MessageHeader.decoder)
-            |> Http.send NewMailbox
+            |> Http.send MailboxResult
 
 
 deleteMessage : Model -> Message -> ( Model, Cmd Msg, Session.Msg )
 deleteMessage model msg =
     let
         url =
-            inbucketBase ++ "/api/v1/mailbox/" ++ msg.mailbox ++ "/" ++ msg.id
+            "/api/v1/mailbox/" ++ msg.mailbox ++ "/" ++ msg.id
 
         cmd =
             HttpUtil.delete url
@@ -140,35 +158,46 @@ getMessage : String -> String -> Cmd Msg
 getMessage mailbox id =
     let
         url =
-            inbucketBase ++ "/api/v1/mailbox/" ++ mailbox ++ "/" ++ id
+            "/serve/m/" ++ mailbox ++ "/" ++ id
     in
         Http.get url Message.decoder
-            |> Http.send NewMessage
+            |> Http.send MessageResult
 
 
 
--- VIEW --
+-- VIEW
 
 
 view : Session -> Model -> Html Msg
 view session model =
     div [ id "page", class "mailbox" ]
-        [ aside [ id "message-list" ] [ viewMailbox model ]
-        , main_ [ id "message" ] [ viewMessage model ]
+        [ aside [ id "message-list" ] [ messageList model ]
+        , main_
+            [ id "message" ]
+            [ case model.message of
+                Just message ->
+                    viewMessage message model.bodyMode
+
+                Nothing ->
+                    text
+                        ("Select a message on the left,"
+                            ++ " or enter a different username into the box on upper right."
+                        )
+            ]
         ]
 
 
-viewMailbox : Model -> Html Msg
-viewMailbox model =
-    div [] (List.map (viewHeader model) (List.reverse model.headers))
+messageList : Model -> Html Msg
+messageList model =
+    div [] (List.map (messageChip model.selected) (List.reverse model.headers))
 
 
-viewHeader : Model -> MessageHeader -> Html Msg
-viewHeader mailbox msg =
+messageChip : Maybe String -> MessageHeader -> Html Msg
+messageChip selected msg =
     div
         [ classList
             [ ( "message-list-entry", True )
-            , ( "selected", mailbox.selected == Just msg.id )
+            , ( "selected", selected == Just msg.id )
             , ( "unseen", not msg.seen )
             ]
         , onClick (ClickMessage msg.id)
@@ -179,38 +208,92 @@ viewHeader mailbox msg =
         ]
 
 
-viewMessage : Model -> Html Msg
-viewMessage model =
-    case model.message of
-        Just message ->
-            div []
-                [ div [ class "button-bar" ]
-                    [ button [ class "danger", onClick (DeleteMessage message) ] [ text "Delete" ]
-                    , a
-                        [ href
-                            (inbucketBase
-                                ++ "/mailbox/"
-                                ++ message.mailbox
-                                ++ "/"
-                                ++ message.id
-                                ++ "/source"
-                            )
-                        , target "_blank"
-                        ]
-                        [ button [] [ text "Source" ] ]
-                    ]
-                , dl [ id "message-header" ]
-                    [ dt [] [ text "From:" ]
-                    , dd [] [ text message.from ]
-                    , dt [] [ text "To:" ]
-                    , dd [] (List.map text message.to)
-                    , dt [] [ text "Date:" ]
-                    , dd [] [ text message.date ]
-                    , dt [] [ text "Subject:" ]
-                    , dd [] [ text message.subject ]
-                    ]
-                , article [] [ text message.body.text ]
+viewMessage : Message -> Body -> Html Msg
+viewMessage message bodyMode =
+    let
+        sourceUrl message =
+            "/serve/m/" ++ message.mailbox ++ "/" ++ message.id ++ "/source"
+    in
+        div []
+            [ div [ class "button-bar" ]
+                [ button [ class "danger", onClick (DeleteMessage message) ] [ text "Delete" ]
+                , a
+                    [ href (sourceUrl message), target "_blank" ]
+                    [ button [] [ text "Source" ] ]
                 ]
+            , dl [ id "message-header" ]
+                [ dt [] [ text "From:" ]
+                , dd [] [ text message.from ]
+                , dt [] [ text "To:" ]
+                , dd [] (List.map text message.to)
+                , dt [] [ text "Date:" ]
+                , dd [] [ text message.date ]
+                , dt [] [ text "Subject:" ]
+                , dd [] [ text message.subject ]
+                ]
+            , messageBody message bodyMode
+            , attachments message
+            ]
 
-        Nothing ->
-            text ""
+
+messageBody : Message -> Body -> Html Msg
+messageBody message bodyMode =
+    let
+        bodyModeTab mode label =
+            a
+                [ classList [ ( "active", bodyMode == mode ) ]
+                , onClick (MessageBody mode)
+                , href "javacript:void(0)"
+                ]
+                [ text label ]
+
+        safeHtml =
+            bodyModeTab SafeHtmlBody "Safe HTML"
+
+        plainText =
+            bodyModeTab TextBody "Plain Text"
+
+        tabs =
+            if message.html == "" then
+                [ plainText ]
+            else
+                [ safeHtml, plainText ]
+    in
+        div [ class "tab-panel" ]
+            [ nav [ class "tab-bar" ] tabs
+            , article [ class "message-body" ]
+                [ case bodyMode of
+                    SafeHtmlBody ->
+                        div [ property "innerHTML" (string message.html) ] []
+
+                    TextBody ->
+                        div [ property "innerHTML" (string message.text) ] []
+                ]
+            ]
+
+
+attachments : Message -> Html Msg
+attachments message =
+    let
+        baseUrl =
+            "/serve/m/attach/" ++ message.mailbox ++ "/" ++ message.id ++ "/"
+    in
+        if List.isEmpty message.attachments then
+            div [] []
+        else
+            table [ class "attachments well" ] (List.map (attachmentRow baseUrl) message.attachments)
+
+
+attachmentRow : String -> Message.Attachment -> Html Msg
+attachmentRow baseUrl attach =
+    let
+        url =
+            baseUrl ++ attach.id ++ "/" ++ attach.fileName
+    in
+        tr []
+            [ td []
+                [ a [ href url, target "_blank" ] [ text attach.fileName ]
+                , text (" (" ++ attach.contentType ++ ") ")
+                ]
+            , td [] [ a [ href url, downloadAs attach.fileName, class "button" ] [ text "Download" ] ]
+            ]