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 DateFormat import DateFormat.Relative as Relative import Html exposing (..) import Html.Attributes exposing ( class , classList , download , href , id , placeholder , property , target , type_ , value ) import Html.Events exposing (..) import Http exposing (Error) import HttpUtil import Json.Decode as Decode exposing (Decoder) import Json.Encode as Encode import Ports import Route import Task import Time exposing (Posix) -- MODEL type Body = TextBody | SafeHtmlBody type State = LoadingList (Maybe MessageID) | ShowingList MessageList MessageState type MessageState = NoMessage | LoadingMessage | ShowingMessage VisibleMessage | Transitioning VisibleMessage type alias MessageID = String type alias MessageList = { headers : List MessageHeader , selected : Maybe MessageID , searchFilter : String } type alias VisibleMessage = { message : Message , markSeenAt : Maybe Int } type alias Model = { mailboxName : String , state : State , bodyMode : Body , searchInput : String , now : Posix } init : String -> Maybe MessageID -> ( Model, Cmd Msg ) init mailboxName selection = ( Model mailboxName (LoadingList selection) SafeHtmlBody "" (Time.millisToPosix 0) , load mailboxName ) load : String -> Cmd Msg load mailboxName = Cmd.batch [ Ports.windowTitle (mailboxName ++ " - Inbucket") , Task.perform Tick Time.now , getList mailboxName ] -- SUBSCRIPTIONS subscriptions : Model -> Sub Msg subscriptions model = let subSeen = case model.state of ShowingList _ (ShowingMessage { message }) -> if message.seen then Sub.none else Time.every 250 SeenTick _ -> Sub.none in Sub.batch [ Time.every (30 * 1000) Tick , subSeen ] -- UPDATE type Msg = ClickMessage 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 Posix | Purge | PurgeResult (Result Http.Error ()) | SearchInput String | SeenTick Posix | Tick Posix | ViewMessage MessageID update : Session -> Msg -> Model -> ( Model, Cmd Msg, Session.Msg ) update session msg model = case msg of ClickMessage id -> ( updateSelected model id , Cmd.batch [ -- Update browser location. Route.newUrl session.key (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 message -> updateDeleteMessage model message 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 Nothing "") NoMessage } 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 message) -> updateMessageResult model message MessageResult (Err err) -> ( model, Cmd.none, Session.SetFlash (HttpUtil.errorString err) ) MessageBody bodyMode -> ( { model | bodyMode = bodyMode }, Cmd.none, Session.none ) SearchInput searchInput -> updateSearchInput model searchInput OpenedTime time -> case model.state of ShowingList list (ShowingMessage visible) -> if visible.message.seen then ( model, Cmd.none, Session.none ) else -- Set 1500ms delay before reporting message as seen to backend. let markSeenAt = Time.posixToMillis time + 1500 in ( { model | state = ShowingList list (ShowingMessage { visible | markSeenAt = Just markSeenAt } ) } , Cmd.none , Session.none ) _ -> ( model, Cmd.none, Session.none ) Purge -> updatePurge model PurgeResult (Ok _) -> ( model, Cmd.none, Session.none ) PurgeResult (Err err) -> ( model, Cmd.none, Session.SetFlash (HttpUtil.errorString err) ) SeenTick now -> case model.state of ShowingList _ (ShowingMessage { message, markSeenAt }) -> case markSeenAt of Just deadline -> if Time.posixToMillis now >= deadline then updateMarkMessageSeen model message else ( model, Cmd.none, Session.none ) Nothing -> ( model, Cmd.none, Session.none ) _ -> ( model, Cmd.none, Session.none ) Tick now -> ( { model | now = now }, Cmd.none, Session.none ) {-| Replace the currently displayed message. -} updateMessageResult : Model -> Message -> ( Model, Cmd Msg, Session.Msg ) updateMessageResult model message = let bodyMode = if message.html == "" then TextBody else model.bodyMode in case model.state of LoadingList _ -> ( model, Cmd.none, Session.none ) ShowingList list _ -> ( { model | state = ShowingList { list | selected = Just message.id } (ShowingMessage (VisibleMessage message Nothing)) , bodyMode = bodyMode } , Task.perform OpenedTime Time.now , Session.none ) updatePurge : Model -> ( Model, Cmd Msg, Session.Msg ) updatePurge model = let cmd = "/api/v1/mailbox/" ++ model.mailboxName |> HttpUtil.delete PurgeResult in case model.state of ShowingList list _ -> ( { model | state = ShowingList (MessageList [] Nothing "") NoMessage } , cmd , Session.none ) _ -> ( model, cmd, Session.none ) updateSearchInput : Model -> String -> ( Model, Cmd Msg, Session.Msg ) updateSearchInput model searchInput = let searchFilter = if String.length searchInput > 1 then String.toLower searchInput else "" in case model.state of LoadingList _ -> ( model, Cmd.none, Session.none ) ShowingList list messageState -> ( { model | searchInput = searchInput , state = ShowingList { list | searchFilter = searchFilter } messageState } , Cmd.none , Session.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, Cmd Msg, Session.Msg ) updateDeleteMessage model message = let url = "/api/v1/mailbox/" ++ message.mailbox ++ "/" ++ message.id cmd = HttpUtil.delete DeleteMessageResult url 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 } , cmd , Session.none ) _ -> ( model, cmd, Session.none ) updateMarkMessageSeen : Model -> Message -> ( Model, Cmd Msg, Session.Msg ) updateMarkMessageSeen model message = case model.state of ShowingList list (ShowingMessage visible) -> let 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 MarkSeenResult url map f messageList = { messageList | headers = List.map f messageList.headers } in ( { model | state = ShowingList (map updateSeen list) (ShowingMessage { visible | message = { message | seen = True } , markSeenAt = Nothing } ) } , command , Session.None ) _ -> ( model, Cmd.none, Session.none ) getList : String -> Cmd Msg getList mailboxName = let url = "/api/v1/mailbox/" ++ mailboxName in Http.get { url = url , expect = Http.expectJson ListResult (Decode.list MessageHeader.decoder) } getMessage : String -> MessageID -> Cmd Msg getMessage mailboxName id = let url = "/serve/m/" ++ mailboxName ++ "/" ++ id in Http.get { url = url , expect = Http.expectJson MessageResult Message.decoder } -- VIEW view : Session -> Model -> Html Msg view session model = div [ id "page", class "mailbox" ] [ viewMessageList session model , main_ [ id "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 message model.bodyMode ShowingList _ (Transitioning { message }) -> viewMessage message model.bodyMode _ -> text "" ] ] viewMessageList : Session -> Model -> Html Msg viewMessageList session model = aside [ id "message-list" ] [ div [] [ input [ type_ "search" , placeholder "search" , onInput SearchInput , value model.searchInput ] [] , button [ onClick Purge ] [ text "Purge" ] ] , case model.state of LoadingList _ -> div [] [] ShowingList list _ -> div [] (list |> filterMessageList |> List.reverse |> List.map (messageChip model list.selected) ) ] messageChip : Model -> Maybe MessageID -> MessageHeader -> Html Msg messageChip model selected message = div [ classList [ ( "message-list-entry", True ) , ( "selected", selected == Just message.id ) , ( "unseen", not message.seen ) ] , onClick (ClickMessage message.id) ] [ div [ class "subject" ] [ text message.subject ] , div [ class "from" ] [ text message.from ] , div [ class "date" ] [ relativeDate model message.date ] ] viewMessage : Message -> Body -> Html Msg viewMessage message bodyMode = let sourceUrl = "/serve/m/" ++ message.mailbox ++ "/" ++ message.id ++ "/source" in div [] [ div [ class "button-bar" ] [ button [ class "danger", onClick (DeleteMessage message) ] [ text "Delete" ] , a [ href sourceUrl, 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 [] [ verboseDate 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, download attach.fileName, class "button" ] [ text "Download" ] ] ] relativeDate : Model -> Posix -> Html Msg relativeDate model date = Relative.relativeTime model.now date |> text verboseDate : Posix -> Html Msg verboseDate date = DateFormat.format [ DateFormat.monthNameFull , DateFormat.text " " , DateFormat.dayOfMonthSuffix , DateFormat.text ", " , DateFormat.yearNumber , DateFormat.text " " , DateFormat.hourNumber , DateFormat.text ":" , DateFormat.minuteFixed , DateFormat.text ":" , DateFormat.secondFixed , DateFormat.text " " , DateFormat.amPmUppercase ] Time.utc date |> text -- 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