Send read receipts for messages received after opening room.

This commit is contained in:
Danila Fedorin 2018-12-15 19:22:49 -08:00
parent 2529f6f7ae
commit 6c96bae01f
3 changed files with 26 additions and 1 deletions

View File

@ -72,6 +72,7 @@ update msg model = case msg of
ChangeRoomText r t -> ({ model | roomText = Dict.insert r t model.roomText}, Cmd.none) ChangeRoomText r t -> ({ model | roomText = Dict.insert r t model.roomText}, Cmd.none)
SendRoomText r -> updateSendRoomText model r SendRoomText r -> updateSendRoomText model r
SendRoomTextResponse r -> (model, Cmd.none) SendRoomTextResponse r -> (model, Cmd.none)
ReceiveCompletedReadMarker r -> (model, Cmd.none)
updateViewportAfterMessage : Model -> Result Browser.Dom.Error Viewport -> (Model, Cmd Msg) updateViewportAfterMessage : Model -> Result Browser.Dom.Error Viewport -> (Model, Cmd Msg)
updateViewportAfterMessage m vr = updateViewportAfterMessage m vr =
@ -135,7 +136,8 @@ updateSyncResponse model r notify =
, room = s , room = s
}) <| notification sr }) <| notification sr
else Cmd.none else Cmd.none
roomMessages sr = case currentRoomId model of room = currentRoomId model
roomMessages sr = case room of
Just rid -> List.filter (((==) "m.room.message") << .type_) Just rid -> List.filter (((==) "m.room.message") << .type_)
<| Maybe.withDefault [] <| Maybe.withDefault []
<| Maybe.andThen .events <| Maybe.andThen .events
@ -148,6 +150,9 @@ updateSyncResponse model r notify =
<| roomMessages sr <| roomMessages sr
then Cmd.none then Cmd.none
else Task.attempt ViewportAfterMessage (Browser.Dom.getViewportOf "events-wrapper") else Task.attempt ViewportAfterMessage (Browser.Dom.getViewportOf "events-wrapper")
setReadReceiptCmd sr = case (room, List.head <| List.reverse <| roomMessages sr) of
(Just rid, Just re) -> setReadMarkers model.apiUrl token rid re.eventId <| Just re.eventId
_ -> Cmd.none
in in
case r of case r of
Ok sr -> ({ model | sync = mergeSyncResponse model.sync sr }, Cmd.batch Ok sr -> ({ model | sync = mergeSyncResponse model.sync sr }, Cmd.batch
@ -155,6 +160,7 @@ updateSyncResponse model r notify =
, newUserCmd sr , newUserCmd sr
, notificationCmd sr , notificationCmd sr
, setScrollCmd sr , setScrollCmd sr
, setReadReceiptCmd sr
]) ])
_ -> (model, syncCmd) _ -> (model, syncCmd)

View File

@ -1,6 +1,7 @@
module Scylla.Http exposing (..) module Scylla.Http exposing (..)
import Scylla.Model exposing (..) import Scylla.Model exposing (..)
import Scylla.Api exposing (..) import Scylla.Api exposing (..)
import Scylla.Route exposing (RoomId)
import Scylla.Sync exposing (syncResponseDecoder) import Scylla.Sync exposing (syncResponseDecoder)
import Scylla.Login exposing (loginResponseDecoder, Username, Password) import Scylla.Login exposing (loginResponseDecoder, Username, Password)
import Scylla.UserData exposing (userDataDecoder, UserData) import Scylla.UserData exposing (userDataDecoder, UserData)
@ -81,3 +82,20 @@ userData apiUrl token username = request
, timeout = Nothing , timeout = Nothing
, tracker = Nothing , tracker = Nothing
} }
setReadMarkers : ApiUrl -> ApiToken -> String -> RoomId -> Maybe String -> Cmd Msg
setReadMarkers apiUrl token roomId fullyRead readReceipt =
let
readReciptFields = case readReceipt of
Just s -> [ ("m.read", string s) ]
_ -> []
in
request
{ method = "POST"
, headers = authenticatedHeaders token
, url = (fullClientUrl apiUrl) ++ "/rooms/" ++ roomId ++ "/read_markers"
, body = jsonBody <| object <| [ ("m.fully_read", string fullyRead) ] ++ readReciptFields
, expect = expectWhatever ReceiveCompletedReadMarker
, timeout = Nothing
, tracker = Nothing
}

View File

@ -43,6 +43,7 @@ type Msg =
| ReceiveSyncResponse (Result Http.Error SyncResponse) -- HTTP, Sync has finished | ReceiveSyncResponse (Result Http.Error SyncResponse) -- HTTP, Sync has finished
| ReceiveLoginResponse (Result Http.Error LoginResponse) -- HTTP, Login has finished | ReceiveLoginResponse (Result Http.Error LoginResponse) -- HTTP, Login has finished
| ReceiveUserData Username (Result Http.Error UserData) | ReceiveUserData Username (Result Http.Error UserData)
| ReceiveCompletedReadMarker (Result Http.Error ())
displayName : Model -> Username -> String displayName : Model -> Username -> String
displayName m s = Maybe.withDefault (senderName s) <| Maybe.andThen .displayName <| Dict.get s m.userData displayName m s = Maybe.withDefault (senderName s) <| Maybe.andThen .displayName <| Dict.get s m.userData