Send read receipts for messages received after opening room.

このコミットが含まれているのは:
Danila Fedorin 2018-12-15 19:22:49 -08:00
コミット 6c96bae01f
3個のファイルの変更26行の追加1行の削除

ファイルの表示

@ -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)

ファイルの表示

@ -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
}

ファイルの表示

@ -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