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

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

import Api
import Data.Message as Message exposing (Message)
import Data.MessageHeader exposing (MessageHeader)
import Data.Session exposing (Session)
import DateFormat as DF
import DateFormat.Relative as Relative
import Effect exposing (Effect)
import Html
    exposing
        ( Attribute
        , Html
        , a
        , article
        , aside
        , button
        , dd
        , div
        , dl
        , dt
        , h3
        , i
        , input
        , li
        , main_
        , nav
        , p
        , span
        , table
        , td
        , text
        , tr
        , ul
        )
import Html.Attributes
    exposing
        ( alt
        , class
        , classList
        , disabled
        , download
        , href
        , placeholder
        , property
        , tabindex
        , target
        , type_
        , value
        )
import Html.Events as Events
import HttpUtil
import Json.Decode as D
import Json.Encode as E
import Modal
import Route
import Time exposing (Posix)
import Timer exposing (Timer)



-- MODEL


type Body
    = TextBody
    | SafeHtmlBody


type State
    = LoadingList (Maybe MessageID)
    | ShowingList MessageList MessageState


type MessageState
    = NoMessage
    | LoadingMessage
    | ShowingMessage Message
    | Transitioning Message


type alias MessageID =
    String


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


type alias Model =
    { session : Session
    , mailboxName : String
    , state : State
    , socketConnected : Bool
    , bodyMode : Body
    , searchInput : String
    , promptPurge : Bool
    , markSeenTimer : Timer
    , now : Posix
    }


type alias ServeUrl =
    List String -> String


init : Session -> String -> Maybe MessageID -> ( Model, Effect Msg )
init session mailboxName selection =
    ( { session = session
      , mailboxName = mailboxName
      , state = LoadingList selection
      , socketConnected = False
      , bodyMode = SafeHtmlBody
      , searchInput = ""
      , promptPurge = False
      , markSeenTimer = Timer.empty
      , now = Time.millisToPosix 0
      }
    , Effect.batch
        [ Effect.posixTime Tick
        , Effect.getHeaderList ListLoaded mailboxName
        ]
    )



-- SUBSCRIPTIONS


subscriptions : Model -> Sub Msg
subscriptions _ =
    Time.every (30 * 1000) Tick



-- UPDATE


type Msg
    = ListLoaded (Result HttpUtil.Error (List MessageHeader))
    | ClickMessage MessageID
    | ClickRefresh
    | ListKeyPress String Int
    | CloseMessage
    | MessageLoaded (Result HttpUtil.Error Message)
    | MessageBody Body
    | MarkSeenTriggered Timer
    | MarkSeenLoaded (Result HttpUtil.Error ())
    | DeleteMessage Message
    | DeletedMessage (Result HttpUtil.Error ())
    | PurgeMailboxPrompt
    | PurgeMailboxCanceled
    | PurgeMailboxConfirmed
    | PurgedMailbox (Result HttpUtil.Error ())
    | OnSearchInput String
    | Tick Posix
    | ModalFocused Modal.Msg


update : Msg -> Model -> ( Model, Effect Msg )
update msg model =
    case msg of
        ClickMessage id ->
            ( updateSelected model id
            , Effect.batch
                [ -- Update browser location.
                  Effect.updateRoute (Route.Message model.mailboxName id)
                , Effect.getMessage MessageLoaded model.mailboxName id
                ]
            )

        ClickRefresh ->
            let
                selection =
                    case model.state of
                        ShowingList _ (ShowingMessage message) ->
                            Just message.id

                        _ ->
                            Nothing
            in
            -- Reset to loading state, preserving the current message selection.
            ( { model | state = LoadingList selection }
            , Effect.getHeaderList ListLoaded model.mailboxName
            )

        CloseMessage ->
            case model.state of
                ShowingList list _ ->
                    ( { model | state = ShowingList list NoMessage }, Effect.none )

                _ ->
                    ( model, Effect.none )

        DeleteMessage message ->
            updateDeleteMessage model message

        DeletedMessage (Ok _) ->
            ( model, Effect.none )

        DeletedMessage (Err err) ->
            ( model, Effect.showFlash (HttpUtil.errorFlash err) )

        ListKeyPress id keyCode ->
            case keyCode of
                13 ->
                    updateOpenMessage model id

                _ ->
                    ( model, Effect.none )

        ListLoaded (Ok headers) ->
            updateListLoaded model headers

        ListLoaded (Err err) ->
            ( model, Effect.showFlash (HttpUtil.errorFlash err) )

        MarkSeenLoaded (Ok _) ->
            ( model, Effect.none )

        MarkSeenLoaded (Err err) ->
            ( model, Effect.showFlash (HttpUtil.errorFlash err) )

        MessageLoaded (Ok message) ->
            updateMessageResult model message

        MessageLoaded (Err err) ->
            ( model, Effect.showFlash (HttpUtil.errorFlash err) )

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

        ModalFocused message ->
            ( model, Effect.focusModalResult message )

        OnSearchInput searchInput ->
            updateSearchInput model searchInput

        PurgeMailboxPrompt ->
            ( { model | promptPurge = True }, Effect.focusModal ModalFocused )

        PurgeMailboxCanceled ->
            ( { model | promptPurge = False }, Effect.none )

        PurgeMailboxConfirmed ->
            updateTriggerPurge model

        PurgedMailbox (Ok _) ->
            ( model, Effect.none )

        PurgedMailbox (Err err) ->
            ( model, Effect.showFlash (HttpUtil.errorFlash err) )

        MarkSeenTriggered timer ->
            if timer == model.markSeenTimer then
                -- Matching timer means we have changed messages, mark this one seen.
                updateMarkMessageSeen model

            else
                ( model, Effect.none )

        Tick now ->
            ( { model | now = now }, Effect.none )


updateListLoaded : Model -> List MessageHeader -> ( Model, Effect Msg )
updateListLoaded model headers =
    case model.state of
        LoadingList selection ->
            let
                newModel =
                    { model
                        | state = ShowingList (MessageList headers Nothing "") NoMessage
                    }
            in
            Effect.append (Effect.addRecent newModel.mailboxName) <|
                case selection of
                    Just id ->
                        -- Don't try to load selected message if not present in headers.
                        if List.any (\header -> Just header.id == selection) headers then
                            updateOpenMessage newModel id

                        else
                            ( newModel, Effect.updateRoute (Route.Mailbox model.mailboxName) )

                    Nothing ->
                        ( newModel, Effect.none )

        _ ->
            ( model, Effect.none )


{-| Replace the currently displayed message.
-}
updateMessageResult : Model -> Message -> ( Model, Effect Msg )
updateMessageResult model message =
    let
        bodyMode =
            if message.html == "" then
                TextBody

            else
                model.bodyMode
    in
    case model.state of
        LoadingList _ ->
            ( model, Effect.none )

        ShowingList list _ ->
            let
                newTimer =
                    Timer.replace model.markSeenTimer
            in
            ( { model
                | state =
                    ShowingList
                        { list | selected = Just message.id }
                        (ShowingMessage message)
                , bodyMode = bodyMode
                , markSeenTimer = newTimer
              }
              -- Set 1500ms delay before reporting message as seen to backend.
            , Effect.schedule MarkSeenTriggered newTimer 1500
            )


{-| Updates model and triggers commands to purge this mailbox.
-}
updateTriggerPurge : Model -> ( Model, Effect Msg )
updateTriggerPurge model =
    ( { model
        | promptPurge = False
        , state = ShowingList (MessageList [] Nothing "") NoMessage
      }
    , Effect.batch
        [ Effect.updateRoute (Route.Mailbox model.mailboxName)
        , Effect.purgeMailbox PurgedMailbox model.mailboxName
        ]
    )


updateSearchInput : Model -> String -> ( Model, Effect Msg )
updateSearchInput model searchInput =
    let
        searchFilter =
            if String.length searchInput > 1 then
                String.toLower searchInput

            else
                ""
    in
    case model.state of
        LoadingList _ ->
            ( model, Effect.none )

        ShowingList list messageState ->
            ( { model
                | searchInput = searchInput
                , state = ShowingList { list | searchFilter = searchFilter } messageState
              }
            , Effect.none
            )


{-| Set the selected message in our model.
-}
updateSelected : Model -> MessageID -> Model
updateSelected model id =
    case model.state of
        LoadingList _ ->
            model

        ShowingList list messageState ->
            let
                newList =
                    { list | selected = Just id }
            in
            case messageState of
                NoMessage ->
                    { model | state = ShowingList newList LoadingMessage }

                LoadingMessage ->
                    { model | state = ShowingList newList LoadingMessage }

                ShowingMessage visible ->
                    -- Use Transitioning state to prevent blank message flicker.
                    { model | state = ShowingList newList (Transitioning visible) }

                Transitioning visible ->
                    { model | state = ShowingList newList (Transitioning visible) }


updateDeleteMessage : Model -> Message -> ( Model, Effect Msg )
updateDeleteMessage model message =
    let
        filter f messageList =
            { messageList | headers = List.filter f messageList.headers }
    in
    case model.state of
        ShowingList list _ ->
            ( { model | state = ShowingList (filter (\x -> x.id /= message.id) list) NoMessage }
            , Effect.batch
                [ Effect.deleteMessage DeletedMessage message.mailbox message.id
                , Effect.updateRoute (Route.Mailbox model.mailboxName)
                ]
            )

        _ ->
            ( model, Effect.none )


{-| Updates both the active message, and the message list to mark the currently viewed message as seen.
-}
updateMarkMessageSeen : Model -> ( Model, Effect Msg )
updateMarkMessageSeen model =
    case model.state of
        ShowingList messages (ShowingMessage visibleMessage) ->
            let
                updateHeader header =
                    if header.id == visibleMessage.id then
                        { header | seen = True }

                    else
                        header

                newMessages =
                    { messages | headers = List.map updateHeader messages.headers }
            in
            ( { model
                | state =
                    ShowingList newMessages (ShowingMessage { visibleMessage | seen = True })
              }
            , Effect.markMessageSeen MarkSeenLoaded visibleMessage.mailbox visibleMessage.id
            )

        _ ->
            ( model, Effect.none )


updateOpenMessage : Model -> String -> ( Model, Effect Msg )
updateOpenMessage model id =
    ( updateSelected model id
    , Effect.getMessage MessageLoaded model.mailboxName id
    )



-- VIEW


view : Model -> { title : String, modal : Maybe (Html Msg), content : List (Html Msg) }
view model =
    let
        serveUrl : ServeUrl
        serveUrl =
            Api.serveUrl model.session

        mode =
            case model.state of
                ShowingList _ (ShowingMessage _) ->
                    "message-active"

                _ ->
                    "list-active"
    in
    { title = model.mailboxName ++ " - Inbucket"
    , modal = viewModal model.promptPurge
    , content =
        [ div [ class ("mailbox " ++ mode) ]
            [ viewMessageListControls model
            , viewMessageList model
            , main_
                [ class "message" ]
                [ case model.state of
                    ShowingList _ NoMessage ->
                        text
                            ("Select a message on the left,"
                                ++ " or enter a different username into the box on upper right."
                            )

                    ShowingList _ (ShowingMessage message) ->
                        viewMessage serveUrl model.session.zone message model.bodyMode

                    ShowingList _ (Transitioning message) ->
                        viewMessage serveUrl model.session.zone message model.bodyMode

                    _ ->
                        text ""
                ]
            ]
        ]
    }


viewModal : Bool -> Maybe (Html Msg)
viewModal promptPurge =
    if promptPurge then
        Just <|
            div []
                [ p [] [ text "Are you sure you want to delete all messages in this mailbox?" ]
                , div [ class "button-bar" ]
                    [ button [ Events.onClick PurgeMailboxConfirmed, class "danger" ] [ text "Yes" ]
                    , button [ Events.onClick PurgeMailboxCanceled ] [ text "Cancel" ]
                    ]
                ]

    else
        Nothing


viewMessageListControls : Model -> Html Msg
viewMessageListControls model =
    let
        clearButton =
            Just <|
                button
                    [ Events.onClick (OnSearchInput "")
                    , disabled (model.searchInput == "")
                    , alt "Clear Search"
                    ]
                    [ i [ class "fas fa-times" ] [] ]

        purgeButton =
            Just <|
                button
                    [ Events.onClick PurgeMailboxPrompt
                    , alt "Purge Mailbox"
                    ]
                    [ i [ class "fas fa-trash" ] [] ]

        refreshButton =
            if model.socketConnected then
                Nothing

            else
                Just <|
                    button
                        [ Events.onClick ClickRefresh
                        , alt "Refresh Mailbox"
                        ]
                        [ i [ class "fas fa-sync" ] [] ]

        searchInput =
            Just <|
                input
                    [ type_ "text"
                    , placeholder "search"
                    , Events.onInput OnSearchInput
                    , value model.searchInput
                    ]
                    []
    in
    [ searchInput, clearButton, refreshButton, purgeButton ]
        |> List.filterMap identity
        |> aside [ class "message-list-controls" ]


viewMessageList : Model -> Html Msg
viewMessageList model =
    aside [ class "message-list" ] <|
        case model.state of
            LoadingList _ ->
                []

            ShowingList list _ ->
                list
                    |> filterMessageList
                    |> List.reverse
                    |> List.map (messageChip model list.selected)


messageChip : Model -> Maybe MessageID -> MessageHeader -> Html Msg
messageChip model selected message =
    div
        [ class "message-list-entry"
        , classList
            [ ( "selected", selected == Just message.id )
            , ( "unseen", not message.seen )
            ]
        , Events.onClick (ClickMessage message.id)
        , onKeyUp (ListKeyPress message.id)
        , tabindex 0
        ]
        [ div [ class "subject" ] [ text message.subject ]
        , div [ class "from" ] [ text message.from ]
        , div [ class "date" ] [ relativeDate model message.date ]
        ]


viewMessage : ServeUrl -> Time.Zone -> Message -> Body -> Html Msg
viewMessage serveUrl zone message bodyMode =
    let
        htmlUrl =
            serveUrl [ "mailbox", message.mailbox, message.id, "html" ]

        sourceUrl =
            serveUrl [ "mailbox", message.mailbox, message.id, "source" ]

        htmlButton =
            if message.html == "" then
                text ""

            else
                a [ href htmlUrl, target "_blank" ]
                    [ button [ tabindex -1 ] [ text "Raw HTML" ] ]
    in
    div []
        [ div [ class "button-bar" ]
            [ button [ class "message-close light", Events.onClick CloseMessage ]
                [ i [ class "fas fa-arrow-left" ] [] ]
            , button [ class "danger", Events.onClick (DeleteMessage message) ] [ text "Delete" ]
            , a [ href sourceUrl, target "_blank" ]
                [ button [ tabindex -1 ] [ text "Source" ] ]
            , htmlButton
            ]
        , dl [ class "message-header" ]
            [ dt [] [ text "From:" ]
            , dd [] [ text message.from ]
            , dt [] [ text "To:" ]
            , dd [] [ text (String.join ", " message.to) ]
            , dt [] [ text "Date:" ]
            , dd [] [ verboseDate zone message.date ]
            , dt [] [ text "Subject:" ]
            , dd [] [ text message.subject ]
            ]
        , messageErrors message
        , messageBody message bodyMode
        , attachments serveUrl message
        ]


messageErrors : Message -> Html Msg
messageErrors message =
    let
        row error =
            li []
                [ span
                    [ classList [ ( "message-warn-severe", error.severe ) ] ]
                    [ text (error.name ++ ": ") ]
                , text error.detail
                ]
    in
    case message.errors of
        [] ->
            text ""

        errors ->
            div [ class "well well-warn message-warn" ]
                [ div [] [ h3 [] [ text "MIME problems detected" ] ]
                , ul [] (List.map row errors)
                ]


messageBody : Message -> Body -> Html Msg
messageBody message bodyMode =
    let
        bodyModeTab mode label =
            a
                [ classList [ ( "active", bodyMode == mode ) ]
                , Events.onClick (MessageBody mode)
                , href "#"
                ]
                [ 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 ->
                    Html.node "rendered-html" [ property "content" (E.string message.html) ] []

                TextBody ->
                    Html.node "rendered-html" [ property "content" (E.string message.text) ] []
            ]
        ]


attachments : ServeUrl -> Message -> Html Msg
attachments serveUrl message =
    if List.isEmpty message.attachments then
        text ""

    else
        message.attachments
            |> List.map (attachmentRow serveUrl message)
            |> table [ class "attachments well" ]


attachmentRow : ServeUrl -> Message -> Message.Attachment -> Html Msg
attachmentRow serveUrl message attach =
    let
        url =
            serveUrl
                [ "mailbox"
                , message.mailbox
                , message.id
                , "attach"
                , attach.id
                , attach.fileName
                ]
    in
    tr []
        [ td []
            [ a [ href url, target "_blank" ] [ text attach.fileName ]
            , text (" (" ++ attach.contentType ++ ") ")
            ]
        , td [] [ a [ href url, download attach.fileName, class "button" ] [ text "Download" ] ]
        ]


relativeDate : Model -> Posix -> Html Msg
relativeDate model date =
    Relative.relativeTime model.now date |> text


verboseDate : Time.Zone -> Posix -> Html Msg
verboseDate zone date =
    text <|
        DF.format
            [ DF.monthNameFull
            , DF.text " "
            , DF.dayOfMonthSuffix
            , DF.text ", "
            , DF.yearNumber
            , DF.text " "
            , DF.hourNumber
            , DF.text ":"
            , DF.minuteFixed
            , DF.text ":"
            , DF.secondFixed
            , DF.text " "
            , DF.amPmUppercase
            , DF.text " (Local)"
            ]
            zone
            date



-- UTILITY


filterMessageList : MessageList -> List MessageHeader
filterMessageList list =
    if list.searchFilter == "" then
        list.headers

    else
        let
            matches header =
                String.contains list.searchFilter (String.toLower header.subject)
                    || String.contains list.searchFilter (String.toLower header.from)
        in
        List.filter matches list.headers


onKeyUp : (Int -> msg) -> Attribute msg
onKeyUp tagger =
    Events.on "keyup" (D.map tagger Events.keyCode)