From 70cf5273e94cd086252fe235900e28ffe94ba854 Mon Sep 17 00:00:00 2001 From: Danila Fedorin Date: Sun, 9 Dec 2018 00:35:07 -0800 Subject: [PATCH] Add long polling live updates. --- src/Main.elm | 10 +++-- src/Scylla/Http.elm | 17 +++++++-- src/Scylla/Sync.elm | 90 ++++++++++++++++++++++++++++++++++++++++++++- 3 files changed, 110 insertions(+), 7 deletions(-) diff --git a/src/Main.elm b/src/Main.elm index 64e8c30..7420373 100644 --- a/src/Main.elm +++ b/src/Main.elm @@ -71,9 +71,13 @@ updateLoginResponse model r = case r of Err e -> (model, Cmd.none) updateSyncResponse : Model -> Result Http.Error SyncResponse -> (Model, Cmd Msg) -updateSyncResponse model r = let sync = model.sync in case r of - Ok sr -> ({ model | sync = mergeSyncResponse model.sync sr }, Cmd.none) - _ -> (model, Cmd.none) +updateSyncResponse model r = + let + cmd = sync model.sync.nextBatch model.apiUrl <| Maybe.withDefault "" model.token + in + case r of + Ok sr -> ({ model | sync = mergeSyncResponse model.sync sr }, cmd) + _ -> (model, cmd) subscriptions : Model -> Sub Msg subscriptions m = Sub.none diff --git a/src/Scylla/Http.elm b/src/Scylla/Http.elm index 113e335..b2ac6a3 100644 --- a/src/Scylla/Http.elm +++ b/src/Scylla/Http.elm @@ -3,8 +3,8 @@ import Scylla.Model exposing (..) import Scylla.Api exposing (..) import Scylla.Sync exposing (syncResponseDecoder) import Scylla.Login exposing (loginResponseDecoder, Username, Password) -import Json.Encode exposing (object, string) -import Http exposing (request, jsonBody, expectJson) +import Json.Encode exposing (object, string, int) +import Http exposing (request, emptyBody, jsonBody, expectJson) fullUrl : ApiUrl -> ApiUrl fullUrl s = s ++ "/_matrix/client/r0" @@ -15,7 +15,18 @@ firstSync apiUrl token = request { method = "GET" , headers = authenticatedHeaders token , url = (fullUrl apiUrl) ++ "/sync" - , body = jsonBody <| object [] + , body = emptyBody + , expect = expectJson ReceiveSyncResponse syncResponseDecoder + , timeout = Nothing + , tracker = Nothing + } + +sync : String -> ApiUrl -> ApiToken -> Cmd Msg +sync nextBatch apiUrl token = request + { method = "GET" + , headers = authenticatedHeaders token + , url = (fullUrl apiUrl) ++ "/sync" ++ "?since=" ++ (nextBatch) ++ "&timeout=10000" + , body = emptyBody , expect = expectJson ReceiveSyncResponse syncResponseDecoder , timeout = Nothing , tracker = Nothing diff --git a/src/Scylla/Sync.elm b/src/Scylla/Sync.elm index 5346055..6217df2 100644 --- a/src/Scylla/Sync.elm +++ b/src/Scylla/Sync.elm @@ -3,6 +3,7 @@ import Scylla.Api exposing (..) 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) +import Set exposing (Set) -- Special Decoding decodeJust : Decoder a -> Decoder (Maybe a) @@ -256,8 +257,95 @@ presenceDecoder = |> maybeDecode "events" (list eventDecoder) -- Business Logic +uniqueByRecursive : (a -> comparable) -> List a -> Set comparable -> List a +uniqueByRecursive f l s = case l of + x::tail -> if Set.member (f x) s + then uniqueByRecursive f tail s + else x::uniqueByRecursive f tail (Set.insert (f x) s) + [] -> [] + +uniqueBy : (a -> comparable) -> List a -> List a +uniqueBy f l = uniqueByRecursive f l Set.empty + +mergeMaybe : (a -> a -> a) -> Maybe a -> Maybe a -> Maybe a +mergeMaybe f l r = case (l, r) of + (Just v1, Just v2) -> Just <| f v1 v2 + (Just v, Nothing) -> Just v + (Nothing, Just v) -> Just v + _ -> Nothing + +mergeEvents : List Event -> List Event -> List Event +mergeEvents l1 l2 = l1 ++ l2 + +mergeStateEvents : List StateEvent -> List StateEvent -> List StateEvent +mergeStateEvents l1 l2 = l1 ++ l2 + +mergeRoomEvents : List RoomEvent -> List RoomEvent -> List RoomEvent +mergeRoomEvents l1 l2 = l1 ++ l2 + +mergeStrippedStates : List StrippedState -> List StrippedState -> List StrippedState +mergeStrippedStates l1 l2 = l1 ++ l2 + +mergeAccountData : AccountData -> AccountData -> AccountData +mergeAccountData a1 a2 = AccountData <| mergeMaybe mergeEvents a1.events a2.events + +mergePresence : Presence -> Presence -> Presence +mergePresence p1 p2 = Presence <| mergeMaybe mergeEvents p1.events p2.events + +mergeDicts : (b -> b -> b) -> Dict comparable b -> Dict comparable b -> Dict comparable b +mergeDicts f d1 d2 = + let + inOne = Dict.insert + inBoth k v1 v2 = Dict.insert k (f v1 v2) + in + Dict.merge inOne inBoth inOne d1 d2 (Dict.empty) + +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 + +mergeJoinedRoom : JoinedRoom -> JoinedRoom -> JoinedRoom +mergeJoinedRoom r1 r2 = + { r2 | state = mergeMaybe mergeState r1.state r2.state + , timeline = mergeMaybe mergeTimeline r1.timeline r2.timeline + , accountData = mergeMaybe mergeAccountData r1.accountData r2.accountData + } + +mergeInviteState : InviteState -> InviteState -> InviteState +mergeInviteState i1 i2 = InviteState <| mergeMaybe mergeStrippedStates i1.events i2.events + +mergeInvitedRoom : InvitedRoom -> InvitedRoom -> InvitedRoom +mergeInvitedRoom i1 i2 = InvitedRoom <| mergeMaybe mergeInviteState i1.inviteState i2.inviteState + +mergeLeftRoom : LeftRoom -> LeftRoom -> LeftRoom +mergeLeftRoom l1 l2 = LeftRoom + (mergeMaybe mergeState l1.state l2.state) + (mergeMaybe mergeTimeline l1.timeline l2.timeline) + (mergeMaybe mergeAccountData l1.accountData l2.accountData) + +mergeJoin : Dict String JoinedRoom -> Dict String JoinedRoom -> Dict String JoinedRoom +mergeJoin = mergeDicts mergeJoinedRoom + +mergeInvite : Dict String InvitedRoom -> Dict String InvitedRoom -> Dict String InvitedRoom +mergeInvite = mergeDicts mergeInvitedRoom + +mergeLeave : Dict String LeftRoom -> Dict String LeftRoom -> Dict String LeftRoom +mergeLeave = mergeDicts mergeLeftRoom + +mergeRooms : Rooms -> Rooms -> Rooms +mergeRooms r1 r2 = + { join = mergeMaybe mergeJoin r1.join r2.join + , invite = mergeMaybe mergeInvite r1.invite r2.invite + , leave = mergeMaybe mergeLeave r1.leave r2.leave + } + mergeSyncResponse : SyncResponse -> SyncResponse -> SyncResponse -mergeSyncResponse l r = r +mergeSyncResponse l r = + { r | rooms = mergeMaybe mergeRooms l.rooms r.rooms + , accountData = mergeMaybe mergeAccountData l.accountData r.accountData + } roomName : JoinedRoom -> Maybe String roomName jr =