Stop making dozens of /profile calls to get usernames

This commit is contained in:
Danila Fedorin 2019-10-09 12:42:33 -07:00
parent 4ef8471585
commit 4505b4ba27
4 changed files with 47 additions and 65 deletions

View File

@ -14,7 +14,6 @@ import Scylla.Model exposing (..)
import Scylla.Http exposing (..) import Scylla.Http exposing (..)
import Scylla.Views exposing (viewFull) import Scylla.Views exposing (viewFull)
import Scylla.Route exposing (Route(..), RoomId) import Scylla.Route exposing (Route(..), RoomId)
import Scylla.UserData exposing (..)
import Scylla.Notification exposing (..) import Scylla.Notification exposing (..)
import Scylla.Storage exposing (..) import Scylla.Storage exposing (..)
import Scylla.Markdown exposing (..) import Scylla.Markdown exposing (..)
@ -51,7 +50,6 @@ init _ url key =
, roomText = Dict.empty , roomText = Dict.empty
, sending = Dict.empty , sending = Dict.empty
, transactionId = 0 , transactionId = 0
, userData = Dict.empty
, connected = True , connected = True
, searchText = "" , searchText = ""
, rooms = emptyOpenRooms , rooms = emptyOpenRooms
@ -86,7 +84,7 @@ update msg model = case msg of
ReceiveLoginResponse a r -> updateLoginResponse model a r ReceiveLoginResponse a r -> updateLoginResponse model a r
ReceiveFirstSyncResponse r -> updateSyncResponse model r False ReceiveFirstSyncResponse r -> updateSyncResponse model r False
ReceiveSyncResponse r -> updateSyncResponse model r True ReceiveSyncResponse r -> updateSyncResponse model r True
ReceiveUserData s r -> updateUserData model s r ReceiveUserData s r -> (model, Cmd.none)
ChangeRoomText r t -> updateChangeRoomText model r t ChangeRoomText r t -> updateChangeRoomText model r t
SendRoomText r -> updateSendRoomText model r SendRoomText r -> updateSendRoomText model r
SendRoomTextResponse t r -> updateSendRoomTextResponse model t r SendRoomTextResponse t r -> updateSendRoomTextResponse model t r
@ -112,12 +110,6 @@ update msg model = case msg of
requestScrollCmd : Cmd Msg requestScrollCmd : Cmd Msg
requestScrollCmd = Task.attempt ViewportAfterMessage (Browser.Dom.getViewportOf "messages-wrapper") requestScrollCmd = Task.attempt ViewportAfterMessage (Browser.Dom.getViewportOf "messages-wrapper")
newUsersCmd : Model -> List Username -> Cmd Msg
newUsersCmd m us = m.token
|> Maybe.map (\t -> List.map (getUserData m.apiUrl t) us)
|> Maybe.withDefault []
|> Cmd.batch
updateSendRoomTextResponse : Model -> Int -> Result Http.Error String -> (Model, Cmd Msg) updateSendRoomTextResponse : Model -> Int -> Result Http.Error String -> (Model, Cmd Msg)
updateSendRoomTextResponse m t r = updateSendRoomTextResponse m t r =
let let
@ -179,16 +171,9 @@ updateUploadSelected m rid f fs msg =
updateHistoryResponse : Model -> RoomId -> Result Http.Error HistoryResponse -> (Model, Cmd Msg) updateHistoryResponse : Model -> RoomId -> Result Http.Error HistoryResponse -> (Model, Cmd Msg)
updateHistoryResponse m r hr = updateHistoryResponse m r hr =
let case hr of
userDataCmd h = newUsersCmd m Ok h -> ({ m | rooms = applyHistoryResponse r h m.rooms }, Cmd.none)
<| newUsers m Err _ -> ({ m | errors = "Unable to load older history from server"::m.errors }, Cmd.none)
<| uniqueBy identity
<| List.map getSender
<| h.chunk
in
case hr of
Ok h -> ({ m | rooms = applyHistoryResponse r h m.rooms }, userDataCmd h)
Err _ -> ({ m | errors = "Unable to load older history from server"::m.errors }, Cmd.none)
updateHistory : Model -> RoomId -> (Model, Cmd Msg) updateHistory : Model -> RoomId -> (Model, Cmd Msg)
updateHistory m r = updateHistory m r =
@ -268,11 +253,6 @@ updateViewportAfterMessage m vr =
in in
(m, Result.withDefault Cmd.none <| Result.map cmd vr) (m, Result.withDefault Cmd.none <| Result.map cmd vr)
updateUserData : Model -> String -> Result Http.Error UserData -> (Model, Cmd Msg)
updateUserData m s r = case r of
Ok ud -> ({ m | userData = Dict.insert s ud m.userData }, Cmd.none)
Err e -> ({ m | errors = ("Failed to retrieve user data for user " ++ s)::m.errors }, Cmd.none)
updateSendRoomText : Model -> RoomId -> (Model, Cmd Msg) updateSendRoomText : Model -> RoomId -> (Model, Cmd Msg)
updateSendRoomText m r = updateSendRoomText m r =
let let
@ -311,9 +291,6 @@ updateSyncResponse model r notify =
nextBatch = Result.withDefault model.nextBatch nextBatch = Result.withDefault model.nextBatch
<| Result.map .nextBatch r <| Result.map .nextBatch r
syncCmd = sync model.apiUrl token nextBatch syncCmd = sync model.apiUrl token nextBatch
userDataCmd sr = newUsersCmd model
<| newUsers model
<| allUsers sr
notification sr = notification sr =
getPushRuleset model.accountData getPushRuleset model.accountData
|> Maybe.map (\rs -> getNotificationEvents rs sr) |> Maybe.map (\rs -> getNotificationEvents rs sr)
@ -324,7 +301,7 @@ updateSyncResponse model r notify =
notificationCmd sr = if notify notificationCmd sr = if notify
then Maybe.withDefault Cmd.none then Maybe.withDefault Cmd.none
<| Maybe.map (\(s, e) -> sendNotificationPort <| Maybe.map (\(s, e) -> sendNotificationPort
{ name = getDisplayName model.userData e.sender { name = roomLocalDisplayName model s e.sender
, text = getText e , text = getText e
, room = s , room = s
}) <| notification sr }) <| notification sr
@ -362,7 +339,6 @@ updateSyncResponse model r notify =
Ok sr -> (newModel sr Ok sr -> (newModel sr
, Cmd.batch , Cmd.batch
[ syncCmd [ syncCmd
, userDataCmd sr
, notificationCmd sr , notificationCmd sr
, setScrollCmd sr , setScrollCmd sr
, setReadReceiptCmd sr , setReadReceiptCmd sr

View File

@ -1,13 +1,14 @@
module Scylla.Model exposing (..) module Scylla.Model exposing (..)
import Scylla.Api exposing (..) import Scylla.Api exposing (..)
import Scylla.Room exposing (getLocalDisplayName)
import Scylla.Sync exposing (SyncResponse, HistoryResponse) import Scylla.Sync exposing (SyncResponse, HistoryResponse)
import Scylla.ListUtils exposing (findFirst) import Scylla.ListUtils exposing (findFirst)
import Scylla.Room exposing (OpenRooms) import Scylla.Room exposing (OpenRooms)
import Scylla.UserData exposing (UserData)
import Scylla.Sync.Rooms exposing (JoinedRoom) import Scylla.Sync.Rooms exposing (JoinedRoom)
import Scylla.Sync.Push exposing (Ruleset) import Scylla.Sync.Push exposing (Ruleset)
import Scylla.Sync.AccountData exposing (AccountData, directMessagesDecoder) import Scylla.Sync.AccountData exposing (AccountData, directMessagesDecoder)
import Scylla.Login exposing (LoginResponse, Username, Password) import Scylla.Login exposing (LoginResponse, Username, Password)
import Scylla.UserData exposing (UserData)
import Scylla.Route exposing (Route(..), RoomId) import Scylla.Route exposing (Route(..), RoomId)
import Scylla.Messages exposing (..) import Scylla.Messages exposing (..)
import Scylla.Storage exposing (..) import Scylla.Storage exposing (..)
@ -36,7 +37,6 @@ type alias Model =
, roomText : Dict RoomId String , roomText : Dict RoomId String
, sending : Dict Int (RoomId, SendingMessage) , sending : Dict Int (RoomId, SendingMessage)
, transactionId : Int , transactionId : Int
, userData : Dict Username UserData
, connected : Bool , connected : Bool
, searchText : String , searchText : String
, rooms : OpenRooms , rooms : OpenRooms
@ -84,10 +84,13 @@ roomUrl s = Url.Builder.absolute [ "room", s ] []
loginUrl : String loginUrl : String
loginUrl = Url.Builder.absolute [ "login" ] [] loginUrl = Url.Builder.absolute [ "login" ] []
newUsers : Model -> List Username -> List Username
newUsers m lus = List.filter (\u -> not <| Dict.member u m.userData) lus
currentRoomId : Model -> Maybe RoomId currentRoomId : Model -> Maybe RoomId
currentRoomId m = case m.route of currentRoomId m = case m.route of
Room r -> Just r Room r -> Just r
_ -> Nothing _ -> Nothing
roomLocalDisplayName : Model -> RoomId -> Username -> String
roomLocalDisplayName m rid u =
case Dict.get rid m.rooms of
Just rd -> getLocalDisplayName rd u
_ -> u

View File

@ -2,7 +2,6 @@ module Scylla.Room exposing (..)
import Scylla.Route exposing (RoomId) import Scylla.Route exposing (RoomId)
import Scylla.Sync exposing (SyncResponse) import Scylla.Sync exposing (SyncResponse)
import Scylla.Login exposing (Username) import Scylla.Login exposing (Username)
import Scylla.UserData exposing (UserData, getDisplayName)
import Scylla.Sync exposing (HistoryResponse) import Scylla.Sync exposing (HistoryResponse)
import Scylla.Sync.Events exposing (MessageEvent, StateEvent, toStateEvent, toMessageEvent) import Scylla.Sync.Events exposing (MessageEvent, StateEvent, toStateEvent, toMessageEvent)
import Scylla.Sync.AccountData exposing (AccountData, getDirectMessages, applyAccountData) import Scylla.Sync.AccountData exposing (AccountData, getDirectMessages, applyAccountData)
@ -133,8 +132,8 @@ getRoomTypingUsers : RoomData -> List String
getRoomTypingUsers = Maybe.withDefault [] getRoomTypingUsers = Maybe.withDefault []
<< getEphemeralData "m.typing" (field "user_ids" (list string)) << getEphemeralData "m.typing" (field "user_ids" (list string))
getRoomName : AccountData -> Dict Username UserData -> RoomId -> RoomData -> String getRoomName : AccountData -> RoomId -> RoomData -> String
getRoomName ad ud rid rd = getRoomName ad rid rd =
let let
customName = getStateData ("m.room.name", "") (field "name" (string)) rd customName = getStateData ("m.room.name", "") (field "name" (string)) rd
direct = getDirectMessages ad direct = getDirectMessages ad
@ -142,9 +141,14 @@ getRoomName ad ud rid rd =
in in
case (customName, direct) of case (customName, direct) of
(Just cn, _) -> cn (Just cn, _) -> cn
(_, Just d) -> getDisplayName ud d (_, Just d) -> getLocalDisplayName rd d
_ -> rid _ -> rid
getLocalDisplayName : RoomData -> Username -> String
getLocalDisplayName rd u =
getStateData ("m.room.member", u) (field "displayname" string) rd
|> Maybe.withDefault u
getNotificationCount : RoomData -> (Int, Int) getNotificationCount : RoomData -> (Int, Int)
getNotificationCount rd = getNotificationCount rd =
( Maybe.withDefault 0 rd.unreadNotifications.notificationCount ( Maybe.withDefault 0 rd.unreadNotifications.notificationCount

View File

@ -3,12 +3,11 @@ import Scylla.Model exposing (..)
import Scylla.Sync exposing (..) import Scylla.Sync exposing (..)
import Scylla.Sync.Events exposing (..) import Scylla.Sync.Events exposing (..)
import Scylla.Sync.Rooms exposing (..) import Scylla.Sync.Rooms exposing (..)
import Scylla.Room exposing (RoomData, emptyOpenRooms, getHomeserver, getRoomName, getRoomTypingUsers) import Scylla.Room exposing (RoomData, emptyOpenRooms, getHomeserver, getRoomName, getRoomTypingUsers, getLocalDisplayName)
import Scylla.Route exposing (..) import Scylla.Route exposing (..)
import Scylla.Fnv as Fnv import Scylla.Fnv as Fnv
import Scylla.Messages exposing (..) import Scylla.Messages exposing (..)
import Scylla.Login exposing (Username) import Scylla.Login exposing (Username)
import Scylla.UserData exposing (UserData, getDisplayName)
import Scylla.Http exposing (fullMediaUrl) import Scylla.Http exposing (fullMediaUrl)
import Scylla.Api exposing (ApiUrl) import Scylla.Api exposing (ApiUrl)
import Scylla.ListUtils exposing (groupBy) import Scylla.ListUtils exposing (groupBy)
@ -21,7 +20,7 @@ import Json.Decode as Decode
import Html exposing (Html, Attribute, div, input, text, button, div, span, a, h2, h3, table, td, tr, img, textarea, video, source, p) import Html exposing (Html, Attribute, div, input, text, button, div, span, a, h2, h3, table, td, tr, img, textarea, video, source, p)
import Html.Attributes exposing (type_, placeholder, value, href, class, style, src, id, rows, controls, src, classList) import Html.Attributes exposing (type_, placeholder, value, href, class, style, src, id, rows, controls, src, classList)
import Html.Events exposing (onInput, onClick, preventDefaultOn) import Html.Events exposing (onInput, onClick, preventDefaultOn)
import Html.Lazy exposing (lazy6) import Html.Lazy exposing (lazy5)
import Dict exposing (Dict) import Dict exposing (Dict)
import Tuple import Tuple
@ -111,14 +110,14 @@ homeserverView m hs rs =
let let
roomList = div [ class "rooms-list" ] roomList = div [ class "rooms-list" ]
<| List.map (\(rid, r) -> roomListElementView m rid r) <| List.map (\(rid, r) -> roomListElementView m rid r)
<| List.sortBy (\(rid, r) -> getRoomName m.accountData m.userData rid r) rs <| List.sortBy (\(rid, r) -> getRoomName m.accountData rid r) rs
in in
div [ class "homeserver-wrapper" ] [ h3 [] [ text hs ], roomList ] div [ class "homeserver-wrapper" ] [ h3 [] [ text hs ], roomList ]
roomListElementView : Model -> RoomId -> RoomData -> Html Msg roomListElementView : Model -> RoomId -> RoomData -> Html Msg
roomListElementView m rid rd = roomListElementView m rid rd =
let let
name = getRoomName m.accountData m.userData rid rd name = getRoomName m.accountData rid rd
isVisible = m.searchText == "" || (String.contains (String.toLower m.searchText) <| String.toLower name) isVisible = m.searchText == "" || (String.contains (String.toLower m.searchText) <| String.toLower name)
isCurrentRoom = case currentRoomId m of isCurrentRoom = case currentRoomId m of
Nothing -> False Nothing -> False
@ -161,7 +160,7 @@ loginView m = div [ class "login-wrapper" ]
joinedRoomView : Model -> RoomId -> RoomData -> Html Msg joinedRoomView : Model -> RoomId -> RoomData -> Html Msg
joinedRoomView m roomId rd = joinedRoomView m roomId rd =
let let
typing = List.map (getDisplayName m.userData) <| getRoomTypingUsers rd typing = List.map (getLocalDisplayName rd) <| getRoomTypingUsers rd
typingText = String.join ", " typing typingText = String.join ", " typing
typingSuffix = case List.length typing of typingSuffix = case List.length typing of
0 -> "" 0 -> ""
@ -182,18 +181,18 @@ joinedRoomView m roomId rd =
] ]
in in
div [ class "room-wrapper" ] div [ class "room-wrapper" ]
[ h2 [] [ text <| getRoomName m.accountData m.userData roomId rd ] [ h2 [] [ text <| getRoomName m.accountData roomId rd ]
, lazy6 lazyMessagesView m.userData roomId rd m.apiUrl m.loginUsername m.sending , lazy5 lazyMessagesView roomId rd m.apiUrl m.loginUsername m.sending
, messageInput , messageInput
, typingWrapper , typingWrapper
] ]
lazyMessagesView : Dict String UserData -> RoomId -> RoomData -> ApiUrl -> Username -> Dict Int (RoomId, SendingMessage) -> Html Msg lazyMessagesView : RoomId -> RoomData -> ApiUrl -> Username -> Dict Int (RoomId, SendingMessage) -> Html Msg
lazyMessagesView ud rid rd au lu snd = lazyMessagesView rid rd au lu snd =
let let
roomReceived = getReceivedMessages rd roomReceived = getReceivedMessages rd
roomSending = getSendingMessages rid snd roomSending = getSendingMessages rid snd
renderedMessages = List.map (userMessagesView ud au) renderedMessages = List.map (userMessagesView rd au)
<| groupMessages lu <| groupMessages lu
<| roomReceived ++ roomSending <| roomReceived ++ roomSending
in in
@ -224,38 +223,38 @@ messagesWrapperView rid es = div [ class "messages-wrapper", id "messages-wrappe
, table [ class "messages-table" ] es , table [ class "messages-table" ] es
] ]
senderView : Dict String UserData -> Username -> Html Msg senderView : RoomData -> Username -> Html Msg
senderView ud s = senderView rd s =
span [ style "color" <| stringColor s, class "sender-wrapper" ] [ text <| getDisplayName ud s ] span [ style "color" <| stringColor s, class "sender-wrapper" ] [ text <| getLocalDisplayName rd s ]
userMessagesView : Dict String UserData -> ApiUrl -> (Username, List Message) -> Html Msg userMessagesView : RoomData -> ApiUrl -> (Username, List Message) -> Html Msg
userMessagesView ud apiUrl (u, ms) = userMessagesView rd apiUrl (u, ms) =
let let
wrap h = div [ class "message" ] [ h ] wrap h = div [ class "message" ] [ h ]
in in
tr [] tr []
[ td [] [ senderView ud u ] [ td [] [ senderView rd u ]
, td [] <| List.map wrap <| List.filterMap (messageView ud apiUrl) ms , td [] <| List.map wrap <| List.filterMap (messageView rd apiUrl) ms
] ]
messageView : Dict String UserData -> ApiUrl -> Message -> Maybe (Html Msg) messageView : RoomData -> ApiUrl -> Message -> Maybe (Html Msg)
messageView ud apiUrl msg = case msg of messageView rd apiUrl msg = case msg of
Sending t -> Just <| sendingMessageView t Sending t -> Just <| sendingMessageView t
Received re -> roomEventView ud apiUrl re Received re -> roomEventView rd apiUrl re
sendingMessageView : SendingMessage -> Html Msg sendingMessageView : SendingMessage -> Html Msg
sendingMessageView msg = case msg.body of sendingMessageView msg = case msg.body of
TextMessage t -> span [ class "sending"] [ text t ] TextMessage t -> span [ class "sending"] [ text t ]
roomEventView : Dict String UserData -> ApiUrl -> MessageEvent -> Maybe (Html Msg) roomEventView : RoomData -> ApiUrl -> MessageEvent -> Maybe (Html Msg)
roomEventView ud apiUrl re = roomEventView rd apiUrl re =
let let
msgtype = Decode.decodeValue (Decode.field "msgtype" Decode.string) re.content msgtype = Decode.decodeValue (Decode.field "msgtype" Decode.string) re.content
in in
case msgtype of case msgtype of
Ok "m.text" -> roomEventTextView re Ok "m.text" -> roomEventTextView re
Ok "m.notice" -> roomEventNoticeView re Ok "m.notice" -> roomEventNoticeView re
Ok "m.emote" -> roomEventEmoteView ud re Ok "m.emote" -> roomEventEmoteView rd re
Ok "m.image" -> roomEventImageView apiUrl re Ok "m.image" -> roomEventImageView apiUrl re
Ok "m.file" -> roomEventFileView apiUrl re Ok "m.file" -> roomEventFileView apiUrl re
Ok "m.video" -> roomEventVideoView apiUrl re Ok "m.video" -> roomEventVideoView apiUrl re
@ -277,10 +276,10 @@ roomEventContent f re =
Just c -> Just <| f c Just c -> Just <| f c
Nothing -> Maybe.map (f << List.singleton << text) <| Result.toMaybe body Nothing -> Maybe.map (f << List.singleton << text) <| Result.toMaybe body
roomEventEmoteView : Dict String UserData -> MessageEvent -> Maybe (Html Msg) roomEventEmoteView : RoomData -> MessageEvent -> Maybe (Html Msg)
roomEventEmoteView ud re = roomEventEmoteView rd re =
let let
emoteText = "* " ++ getDisplayName ud re.sender ++ " " emoteText = "* " ++ getLocalDisplayName rd re.sender ++ " "
in in
roomEventContent (\cs -> span [] (text emoteText :: cs)) re roomEventContent (\cs -> span [] (text emoteText :: cs)) re