go-inbucket/ui/src/Page/Mailbox.elm

module Page.Mailbox exposing (Model, Msg, init, load, subscriptions, update, view)

import Data.Message as Message exposing (Message)
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, downloadAs, href, id, property, target)
import Html.Events exposing (..)
import Http exposing (Error)
import HttpUtil
import Json.Encode as Encode
import Ports
import Route
import Task
import Time exposing (Time)


-- MODEL


type Body
    = TextBody
    | SafeHtmlBody


type State
    = LoadingList (Maybe MessageID)
    | ShowingList MessageList (Maybe MessageID)
    | LoadingMessage MessageList MessageID
    | ShowingMessage MessageList VisibleMessage
    | Transitioning MessageList VisibleMessage MessageID


type alias MessageID =
    String


type alias MessageList =
    { headers : List MessageHeader
    , searchFilter : String
    }


type alias VisibleMessage =
    { message : Message
    , markSeenAt : Maybe Time
    }


type alias Model =
    { mailboxName : String
    , state : State
    , bodyMode : Body
    }


init : String -> Maybe MessageID -> Model
init mailboxName selection =
    Model mailboxName (LoadingList selection) SafeHtmlBody


load : String -> Cmd Msg
load mailboxName =
    Cmd.batch
        [ Ports.windowTitle (mailboxName ++ " - Inbucket")
        , getList mailboxName
        ]



-- SUBSCRIPTIONS


subscriptions : Model -> Sub Msg
subscriptions model =
    case model.state of
        ShowingMessage _ { message } ->
            if message.seen then
                Sub.none
            else
                Time.every (250 * Time.millisecond) Tick

        _ ->
            Sub.none



-- UPDATE


type Msg
    = ClickMessage MessageID
    | ViewMessage MessageID
    | DeleteMessage Message
    | DeleteMessageResult (Result Http.Error ())
    | ListResult (Result Http.Error (List MessageHeader))
    | MarkSeenResult (Result Http.Error ())
    | MessageResult (Result Http.Error Message)
    | MessageBody Body
    | OpenedTime Time
    | Tick Time


update : Session -> Msg -> Model -> ( Model, Cmd Msg, Session.Msg )
update session msg model =
    case msg of
        ClickMessage id ->
            ( updateSelected model id
            , Cmd.batch
                [ Route.newUrl (Route.Message model.mailboxName id)
                , getMessage model.mailboxName id
                ]
            , Session.DisableRouting
            )

        ViewMessage id ->
            ( updateSelected model id
            , getMessage model.mailboxName id
            , Session.AddRecent model.mailboxName
            )

        DeleteMessage msg ->
            deleteMessage model msg

        DeleteMessageResult (Ok _) ->
            ( model, Cmd.none, Session.none )

        DeleteMessageResult (Err err) ->
            ( model, Cmd.none, Session.SetFlash (HttpUtil.errorString err) )

        ListResult (Ok headers) ->
            case model.state of
                LoadingList selection ->
                    let
                        newModel =
                            { model | state = ShowingList (MessageList headers "") selection }
                    in
                        case selection of
                            Just id ->
                                -- Recurse to select message id.
                                update session (ViewMessage id) newModel

                            Nothing ->
                                ( newModel, Cmd.none, Session.AddRecent model.mailboxName )

                _ ->
                    ( model, Cmd.none, Session.none )

        ListResult (Err err) ->
            ( model, Cmd.none, Session.SetFlash (HttpUtil.errorString err) )

        MarkSeenResult (Ok _) ->
            ( model, Cmd.none, Session.none )

        MarkSeenResult (Err err) ->
            ( model, Cmd.none, Session.SetFlash (HttpUtil.errorString err) )

        MessageResult (Ok msg) ->
            let
                bodyMode =
                    if msg.html == "" then
                        TextBody
                    else
                        model.bodyMode

                updateMessage list message =
                    ( { model
                        | state = ShowingMessage list { message = message, markSeenAt = Nothing }
                        , bodyMode = bodyMode
                      }
                    , Task.perform OpenedTime Time.now
                    , Session.none
                    )
            in
                case model.state of
                    LoadingList _ ->
                        ( model, Cmd.none, Session.none )

                    ShowingList list _ ->
                        updateMessage list msg

                    LoadingMessage list _ ->
                        updateMessage list msg

                    ShowingMessage list _ ->
                        updateMessage list msg

                    Transitioning list _ _ ->
                        updateMessage list msg

        MessageResult (Err err) ->
            ( model, Cmd.none, Session.SetFlash (HttpUtil.errorString err) )

        MessageBody bodyMode ->
            ( { model | bodyMode = bodyMode }, Cmd.none, Session.none )

        OpenedTime time ->
            case model.state of
                ShowingMessage list visible ->
                    if visible.message.seen then
                        ( model, Cmd.none, Session.none )
                    else
                        -- Set delay to report message as seen to backend.
                        ( { model
                            | state =
                                ShowingMessage list
                                    { visible
                                        | markSeenAt = Just (time + (1.5 * Time.second))
                                    }
                          }
                        , Cmd.none
                        , Session.none
                        )

                _ ->
                    ( model, Cmd.none, Session.none )

        Tick now ->
            case model.state of
                ShowingMessage _ { message, markSeenAt } ->
                    case markSeenAt of
                        Just deadline ->
                            if now >= deadline then
                                markMessageSeen model message
                            else
                                ( model, Cmd.none, Session.none )

                        Nothing ->
                            ( model, Cmd.none, Session.none )

                _ ->
                    ( model, Cmd.none, Session.none )


updateSelected : Model -> MessageID -> Model
updateSelected model id =
    case model.state of
        ShowingList list _ ->
            { model | state = LoadingMessage list id }

        ShowingMessage list visible ->
            -- Use Transitioning state to prevent message flicker.
            { model | state = Transitioning list visible id }

        Transitioning list visible _ ->
            { model | state = Transitioning list visible id }

        _ ->
            model


getList : String -> Cmd Msg
getList mailboxName =
    let
        url =
            "/api/v1/mailbox/" ++ mailboxName
    in
        Http.get url (Decode.list MessageHeader.decoder)
            |> Http.send ListResult


deleteMessage : Model -> Message -> ( Model, Cmd Msg, Session.Msg )
deleteMessage model msg =
    let
        url =
            "/api/v1/mailbox/" ++ msg.mailbox ++ "/" ++ msg.id

        cmd =
            HttpUtil.delete url
                |> Http.send DeleteMessageResult

        filter f messageList =
            { messageList | headers = List.filter f messageList.headers }
    in
        case model.state of
            ShowingMessage list _ ->
                ( { model
                    | state = ShowingList (filter (\x -> x.id /= msg.id) list) Nothing
                  }
                , cmd
                , Session.none
                )

            _ ->
                ( model, cmd, Session.none )


getMessage : String -> MessageID -> Cmd Msg
getMessage mailboxName id =
    let
        url =
            "/serve/m/" ++ mailboxName ++ "/" ++ id
    in
        Http.get url Message.decoder
            |> Http.send MessageResult


markMessageSeen : Model -> Message -> ( Model, Cmd Msg, Session.Msg )
markMessageSeen model message =
    case model.state of
        ShowingMessage list visible ->
            let
                message =
                    visible.message

                updateSeen header =
                    if header.id == message.id then
                        { header | seen = True }
                    else
                        header

                url =
                    "/api/v1/mailbox/" ++ message.mailbox ++ "/" ++ message.id

                command =
                    -- The URL tells the API what message to update, so we only need to indicate the
                    -- desired change in the body.
                    Encode.object [ ( "seen", Encode.bool True ) ]
                        |> Http.jsonBody
                        |> HttpUtil.patch url
                        |> Http.send MarkSeenResult

                map f messageList =
                    { messageList | headers = List.map f messageList.headers }
            in
                ( { model
                    | state =
                        ShowingMessage (map updateSeen list)
                            { visible
                                | message = { message | seen = True }
                                , markSeenAt = Nothing
                            }
                  }
                , command
                , Session.None
                )

        _ ->
            ( model, Cmd.none, Session.none )



-- VIEW


view : Session -> Model -> Html Msg
view session model =
    div [ id "page", class "mailbox" ]
        [ aside [ id "message-list" ]
            [ case model.state of
                LoadingList _ ->
                    div [] []

                ShowingList list selection ->
                    messageList list selection

                LoadingMessage list selection ->
                    messageList list (Just selection)

                ShowingMessage list visible ->
                    messageList list (Just visible.message.id)

                Transitioning list _ selection ->
                    messageList list (Just selection)
            ]
        , main_
            [ id "message" ]
            [ case model.state of
                ShowingList _ _ ->
                    text
                        ("Select a message on the left,"
                            ++ " or enter a different username into the box on upper right."
                        )

                ShowingMessage _ { message } ->
                    viewMessage message model.bodyMode

                Transitioning _ { message } _ ->
                    viewMessage message model.bodyMode

                _ ->
                    text ""
            ]
        ]


messageList : MessageList -> Maybe MessageID -> Html Msg
messageList list selected =
    div [] (List.map (messageChip selected) (List.reverse list.headers))


messageChip : Maybe MessageID -> MessageHeader -> Html Msg
messageChip selected msg =
    div
        [ classList
            [ ( "message-list-entry", True )
            , ( "selected", selected == Just msg.id )
            , ( "unseen", not msg.seen )
            ]
        , onClick (ClickMessage msg.id)
        ]
        [ div [ class "subject" ] [ text msg.subject ]
        , div [ class "from" ] [ text msg.from ]
        , div [ class "date" ] [ text msg.date ]
        ]


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
            ]


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" (Encode.string message.html) ] []

                    TextBody ->
                        div [ property "innerHTML" (Encode.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" ] ]
            ]