diff --git a/src/Main.elm b/src/Main.elm index 8dff1ab..dbeb8bb 100644 --- a/src/Main.elm +++ b/src/Main.elm @@ -78,7 +78,27 @@ update msg model = case msg of ReceiveCompletedTypingIndicator r -> (model, Cmd.none) ReceiveStoreData d -> updateStoreData model d TypingTick _ -> updateTypingTick model + History r -> updateHistory model r + ReceiveHistoryResponse r hr -> updateHistoryResponse model r hr +updateHistoryResponse : Model -> RoomId -> Result Http.Error HistoryResponse -> (Model, Cmd Msg) +updateHistoryResponse m r hr = case hr of + Ok h -> ({ m | sync = appendHistoryResponse m.sync r h }, Cmd.none) + Err _ -> (m, Cmd.none) + +updateHistory : Model -> RoomId -> (Model, Cmd Msg) +updateHistory m r = + let + prevBatch = Maybe.andThen .prevBatch + <| Maybe.andThen .timeline + <| Maybe.andThen (Dict.get r) + <| Maybe.andThen .join + <| m.sync.rooms + command = case prevBatch of + Just pv -> getHistory m.apiUrl (Maybe.withDefault "" m.token) r pv + Nothing -> Cmd.none + in + (m, command) updateChangeRoomText : Model -> RoomId -> String -> (Model, Cmd Msg) updateChangeRoomText m roomId text = @@ -191,7 +211,7 @@ updateSyncResponse model r notify = token = Maybe.withDefault "" model.token nextBatch = Result.withDefault model.sync.nextBatch <| Result.map .nextBatch r - syncCmd = sync nextBatch model.apiUrl token + syncCmd = sync model.apiUrl token nextBatch newUsers sr = List.filter (\s -> not <| Dict.member s model.userData) <| roomsUsers sr newUserCmd sr = Cmd.batch <| List.map (userData model.apiUrl diff --git a/src/Scylla/Http.elm b/src/Scylla/Http.elm index 472cce8..e886ee1 100644 --- a/src/Scylla/Http.elm +++ b/src/Scylla/Http.elm @@ -2,7 +2,7 @@ module Scylla.Http exposing (..) import Scylla.Model exposing (..) import Scylla.Api exposing (..) import Scylla.Route exposing (RoomId) -import Scylla.Sync exposing (syncResponseDecoder) +import Scylla.Sync exposing (syncResponseDecoder, historyResponseDecoder) import Scylla.Login exposing (loginResponseDecoder, Username, Password) import Scylla.UserData exposing (userDataDecoder, UserData) import Json.Encode exposing (object, string, int, bool) @@ -26,8 +26,8 @@ firstSync apiUrl token = request , tracker = Nothing } -sync : String -> ApiUrl -> ApiToken -> Cmd Msg -sync nextBatch apiUrl token = request +sync : ApiUrl -> ApiToken -> String -> Cmd Msg +sync apiUrl token nextBatch = request { method = "GET" , headers = authenticatedHeaders token , url = (fullClientUrl apiUrl) ++ "/sync" ++ "?since=" ++ (nextBatch) ++ "&timeout=10000" @@ -37,6 +37,17 @@ sync nextBatch apiUrl token = request , tracker = Nothing } +getHistory : ApiUrl -> ApiToken -> RoomId -> String -> Cmd Msg +getHistory apiUrl token room prevBatch = request + { method = "GET" + , headers = authenticatedHeaders token + , url = (fullClientUrl apiUrl) ++ "/rooms/" ++ room ++ "/messages" ++ "?from=" ++ prevBatch ++ "&dir=" ++ "b" + , body = emptyBody + , expect = expectJson (ReceiveHistoryResponse room) historyResponseDecoder + , timeout = Nothing + , tracker = Nothing + } + sendTextMessage : ApiUrl -> ApiToken -> Int -> String -> String -> Cmd Msg sendTextMessage apiUrl token transactionId room message = request { method = "PUT" diff --git a/src/Scylla/Model.elm b/src/Scylla/Model.elm index 4e66036..4855d45 100644 --- a/src/Scylla/Model.elm +++ b/src/Scylla/Model.elm @@ -1,6 +1,6 @@ module Scylla.Model exposing (..) import Scylla.Api exposing (..) -import Scylla.Sync exposing (SyncResponse, JoinedRoom, senderName) +import Scylla.Sync exposing (SyncResponse, HistoryResponse, JoinedRoom, senderName) import Scylla.Login exposing (LoginResponse, Username, Password) import Scylla.UserData exposing (UserData) import Scylla.Route exposing (Route(..), RoomId) @@ -50,6 +50,8 @@ type Msg = | ReceiveCompletedTypingIndicator (Result Http.Error ()) -- HTTP, typing indicator request completed | ReceiveStoreData Json.Decode.Value -- We are send back a value on request from localStorage. | TypingTick Posix -- Tick for updating the typing status + | History RoomId -- Load history for a room + | ReceiveHistoryResponse RoomId (Result Http.Error HistoryResponse) -- HTTP, receive history displayName : Model -> Username -> String displayName m s = Maybe.withDefault (senderName s) <| Maybe.andThen .displayName <| Dict.get s m.userData diff --git a/src/Scylla/Sync.elm b/src/Scylla/Sync.elm index a816ac7..08a0f5b 100644 --- a/src/Scylla/Sync.elm +++ b/src/Scylla/Sync.elm @@ -2,6 +2,7 @@ module Scylla.Sync exposing (..) import Scylla.Api exposing (..) import Scylla.Notification exposing (..) import Scylla.Login exposing (Username) +import Scylla.Route exposing (RoomId) import Dict exposing (Dict) import Json.Decode as Decode exposing (Decoder, int, string, float, list, value, dict, bool, field) import Json.Decode.Pipeline exposing (required, optional) @@ -258,6 +259,20 @@ presenceDecoder = Decode.succeed Presence |> maybeDecode "events" (list eventDecoder) +-- Room History Responses +type alias HistoryResponse = + { start : String + , end : String + , chunk : List RoomEvent + } + +historyResponseDecoder : Decoder HistoryResponse +historyResponseDecoder = + Decode.succeed HistoryResponse + |> required "start" string + |> required "end" string + |> required "chunk" (list roomEventDecoder) + -- Business Logic uniqueByRecursive : (a -> comparable) -> List a -> Set comparable -> List a uniqueByRecursive f l s = case l of @@ -327,7 +342,7 @@ mergeState : State -> State -> State mergeState s1 s2 = State <| mergeMaybe mergeStateEvents s1.events s2.events mergeTimeline : Timeline -> Timeline -> Timeline -mergeTimeline t1 t2 = Timeline (mergeMaybe mergeRoomEvents t1.events t2.events) Nothing t2.prevBatch +mergeTimeline t1 t2 = Timeline (mergeMaybe mergeRoomEvents t1.events t2.events) Nothing t1.prevBatch mergeEphemeral : Ephemeral -> Ephemeral -> Ephemeral mergeEphemeral e1 e2 = Ephemeral <| mergeMaybe mergeEvents e1.events e2.events @@ -374,6 +389,40 @@ mergeSyncResponse l r = , accountData = mergeMaybe mergeAccountData l.accountData r.accountData } +appendRoomHistoryResponse : JoinedRoom -> HistoryResponse -> JoinedRoom +appendRoomHistoryResponse jr hr = + let + oldEvents = Maybe.withDefault [] <| Maybe.andThen .events jr.timeline + newEvents = mergeRoomEvents (List.reverse hr.chunk) oldEvents + newTimeline = case jr.timeline of + Just t -> Just { t | events = Just newEvents, prevBatch = Just hr.end } + Nothing -> Just { events = Just newEvents, prevBatch = Just hr.end, limited = Nothing } + in + { jr | timeline = newTimeline } + +appendHistoryResponse : SyncResponse -> RoomId -> HistoryResponse -> SyncResponse +appendHistoryResponse sr r hr = + let + appendMaybeRoomHistoryResponse mr = Just <| case mr of + Just jr -> appendRoomHistoryResponse jr hr + Nothing -> + { state = Nothing + , timeline = Just + { events = Just hr.chunk + , limited = Nothing + , prevBatch = Just hr.end + } + , ephemeral = Nothing + , accountData = Nothing + , unreadNotifications = Nothing + } + newRooms = Just <| case sr.rooms of + Just rs -> { rs | join = newJoin rs.join } + Nothing -> { join = newJoin Nothing, leave = Nothing, invite = Nothing } + newJoin j = Maybe.map (Dict.update r appendMaybeRoomHistoryResponse) j + in + { sr | rooms = newRooms } + -- Business Logic: Names senderName : String -> String senderName s = diff --git a/src/Scylla/Views.elm b/src/Scylla/Views.elm index 543c012..df46831 100644 --- a/src/Scylla/Views.elm +++ b/src/Scylla/Views.elm @@ -109,12 +109,12 @@ loginView m = div [ class "login-wrapper" ] , button [ onClick AttemptLogin ] [ text "Log In" ] ] -joinedRoomView : Model -> String -> JoinedRoom -> Html Msg +joinedRoomView : Model -> RoomId -> JoinedRoom -> Html Msg joinedRoomView m roomId jr = let events = Maybe.withDefault [] <| Maybe.andThen .events jr.timeline renderedEvents = List.filterMap (eventView m) events - eventWrapper = eventWrapperView m renderedEvents + eventWrapper = eventWrapperView m roomId renderedEvents typing = List.map (displayName m) <| roomTypingUsers jr typingText = String.join ", " typing typingSuffix = case List.length typing of @@ -155,8 +155,11 @@ iconView name = [ Svg.Attributes.class "feather-icon" ] [ Svg.use [ Svg.Attributes.xlinkHref (url ++ "#" ++ name) ] [] ] -eventWrapperView : Model -> List (Html Msg) -> Html Msg -eventWrapperView m es = div [ class "events-wrapper", id "events-wrapper" ] [ table [ class "events-table" ] es ] +eventWrapperView : Model -> RoomId -> List (Html Msg) -> Html Msg +eventWrapperView m rid es = div [ class "events-wrapper", id "events-wrapper" ] + [ a [ class "history-link", onClick <| History rid ] [ text "Load older messages" ] + , table [ class "events-table" ] es + ] eventView : Model -> RoomEvent -> Maybe (Html Msg) eventView m re = diff --git a/static/scss/style.scss b/static/scss/style.scss index fa80d8a..f53f44a 100644 --- a/static/scss/style.scss +++ b/static/scss/style.scss @@ -148,6 +148,14 @@ div.message-wrapper { div.events-wrapper { overflow-y: scroll; flex-grow: 1; + + a.history-link { + display: block; + width: 100%; + text-align: center; + box-sizing: border-box; + padding: 5px; + } } table.events-table {