Matrix-Programs
/
Scylla
1
0
Fork 0
Code Issues 9 Pull Requests Releases Wiki Activity

Fully switch away from keeping sync

This commit is contained in:
Danila Fedorin 2019-09-11 00:52:42 -07:00
parent 29e81a88ac
commit 5c02ae8a58
8 changed files with 127 additions and 120 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
src/Main.elm
View File

@ -44,12 +44,8 @@ init _ url key =
, loginUsername = ""
, loginPassword = ""
, apiUrl = "https://matrix.org"
, sync =
{ nextBatch = ""
, rooms = Nothing
, presence = Nothing
, accountData = Nothing
}
, nextBatch = ""
, accountData = { events = Just [] }
, errors = []
, roomText = Dict.empty
, sending = Dict.empty
@ -67,7 +63,7 @@ init _ url key =
view : Model -> Browser.Document Msg
view m =
let
notificationString = totalNotificationCountString m.sync
notificationString = getTotalNotificationCountString m.rooms
titleString = case notificationString of
Nothing -> "Scylla"
Just s -> s ++ " Scylla"
@ -191,17 +187,14 @@ updateHistoryResponse m r hr =
<| h.chunk
in
case hr of
Ok h -> ({ m | sync = appendHistoryResponse m.sync r h }, userDataCmd h)
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 m r =
let
prevBatch = Maybe.andThen .prevBatch
<| Maybe.andThen .timeline
<| Maybe.andThen (Dict.get r)
<| Maybe.andThen .join
<| m.sync.rooms
prevBatch = Dict.get r m.rooms
|> Maybe.andThen (.prevHistoryBatch)
command = case prevBatch of
Just pv -> getHistory m.apiUrl (Maybe.withDefault "" m.token) r pv
Nothing -> Cmd.none
@ -256,9 +249,10 @@ updateChangeRoute : Model -> Route -> (Model, Cmd Msg)
updateChangeRoute m r =
let
joinedRoom = case r of
Room rid -> Maybe.andThen (Dict.get rid) <| Maybe.andThen .join <| m.sync.rooms
Room rid -> Dict.get rid m.rooms
_ -> Nothing
lastMessage = Maybe.andThen (findLastEvent (((==) "m.room.message") << .type_)) <| Maybe.map (List.filterMap toMessageEvent) <| Maybe.andThen .events <| Maybe.andThen .timeline joinedRoom
lastMessage = Maybe.map .messages joinedRoom
|> Maybe.andThen (findLastEvent (((==) "m.room.message") << .type_))
readMarkerCmd = case (r, lastMessage) of
(Room rid, Just re) -> setReadMarkers m.apiUrl (Maybe.withDefault "" m.token) rid re.eventId <| Just re.eventId
_ -> Cmd.none
@ -314,7 +308,7 @@ updateSyncResponse : Model -> Result Http.Error SyncResponse -> Bool -> (Model,
updateSyncResponse model r notify =
let
token = Maybe.withDefault "" model.token
nextBatch = Result.withDefault model.sync.nextBatch
nextBatch = Result.withDefault model.nextBatch
<| Result.map .nextBatch r
syncCmd = sync model.apiUrl token nextBatch
userDataCmd sr = newUsersCmd model
@ -327,7 +321,7 @@ updateSyncResponse model r notify =
notificationCmd sr = if notify
then Maybe.withDefault Cmd.none
<| Maybe.map (\(s, e) -> sendNotificationPort
{ name = displayName model.userData e.sender
{ name = getDisplayName model.userData e.sender
, text = notificationText e
, room = s
}) <| notification sr
@ -354,12 +348,11 @@ updateSyncResponse model r notify =
receivedTransactions sr = List.filterMap (Maybe.andThen .transactionId << getUnsigned)
<| allTimelineEvents sr
sending sr = Dict.filter (\tid (rid, { body, id }) -> not <| List.member (String.fromInt tid) <| receivedTransactions sr) model.sending
newSync sr = mergeSyncResponse model.sync sr
newModel sr =
{ model | sync = newSync sr
, sending = sending (mergeSyncResponse model.sync sr)
, roomNames = computeRoomsDisplayNames model.userData (newSync sr)
{ model | nextBatch = nextBatch
, sending = sending sr
, rooms = applySync sr model.rooms
, accountData = applyAccountData sr.accountData model.accountData
}
in
case r of

9
src/Scylla/Messages.elm
View File

@ -2,6 +2,7 @@ module Scylla.Messages exposing (..)
import Scylla.Sync.Events exposing (RoomEvent, MessageEvent, toMessageEvent)
import Scylla.Login exposing (Username)
import Scylla.Route exposing (RoomId)
import Scylla.Room exposing (RoomData)
import Dict exposing (Dict)
type SendingMessageBody = TextMessage String
@ -36,10 +37,10 @@ mergeMessages du xs =
in
appendNamed fmu fms fmsl
receivedMessagesRoom : List RoomEvent -> List Message
receivedMessagesRoom es = List.map Received
<| List.filter (\e -> e.type_ == "m.room.message")
<| List.filterMap toMessageEvent es
receivedMessagesRoom : RoomData -> List Message
receivedMessagesRoom rd = rd.messages
|> List.filter (\e -> e.type_ == "m.room.message")
|> List.map Received
sendingMessagesRoom : RoomId -> Dict Int (RoomId, SendingMessage) -> List Message
sendingMessagesRoom rid ms = List.map (\(tid, (_, sm)) -> Sending sm)

47
src/Scylla/Model.elm
View File

@ -1,6 +1,6 @@
module Scylla.Model exposing (..)
import Scylla.Api exposing (..)
import Scylla.Sync exposing (SyncResponse, HistoryResponse, senderName, roomName, roomJoinedUsers)
import Scylla.Sync exposing (SyncResponse, HistoryResponse, roomJoinedUsers)
import Scylla.ListUtils exposing (findFirst)
import Scylla.Room exposing (OpenRooms)
import Scylla.Sync.Rooms exposing (JoinedRoom)
@ -29,7 +29,8 @@ type alias Model =
, loginUsername : Username
, loginPassword : Password
, apiUrl : ApiUrl
, sync : SyncResponse
, accountData : AccountData
, nextBatch : String
, errors : List String
, roomText : Dict RoomId String
, sending : Dict Int (RoomId, SendingMessage)
@ -77,41 +78,6 @@ type Msg =
| AttemptReconnect -- User wants to reconnect to server
| UpdateSearchText String -- Change search text in room list
displayName : Dict String UserData -> Username -> String
displayName ud s = Maybe.withDefault (senderName s) <| Maybe.andThen .displayName <| Dict.get s ud
roomDisplayName : Dict RoomId String -> RoomId -> String
roomDisplayName rd rid =
Maybe.withDefault "<No Name>" <| Dict.get rid rd
computeRoomDisplayName : Dict String UserData -> Maybe AccountData -> RoomId -> JoinedRoom -> Maybe String
computeRoomDisplayName ud ad rid jr =
let
customName = roomName jr
direct = ad
|> Maybe.andThen .events
|> Maybe.andThen (findFirst ((==) "m.direct" << .type_))
|> Maybe.map (Decode.decodeValue directMessagesDecoder << .content)
|> Maybe.andThen Result.toMaybe
|> Maybe.andThen (Dict.get rid)
in
case (customName, direct) of
(Just s, _) -> customName
(_, Just u) -> direct
_ -> Nothing
computeRoomsDisplayNames : Dict String UserData -> SyncResponse -> Dict String String
computeRoomsDisplayNames ud sr =
sr.rooms
|> Maybe.andThen .join
|> Maybe.map Dict.toList
|> Maybe.map (List.foldl
(\(rid, jr) d ->
computeRoomDisplayName ud sr.accountData rid jr
|> Maybe.map (\n -> Dict.insert rid n d)
|> Maybe.withDefault d) Dict.empty)
|> Maybe.withDefault Dict.empty
roomUrl : String -> String
roomUrl s = Url.Builder.absolute [ "room", s ] []
@ -121,13 +87,6 @@ loginUrl = Url.Builder.absolute [ "login" ] []
newUsers : Model -> List Username -> List Username
newUsers m lus = List.filter (\u -> not <| Dict.member u m.userData) lus
joinedRooms : Model -> Dict RoomId JoinedRoom
joinedRooms m = Maybe.withDefault Dict.empty <| Maybe.andThen .join <| m.sync.rooms
currentRoom : Model -> Maybe JoinedRoom
currentRoom m =
Maybe.andThen (\s -> Dict.get s <| joinedRooms m) <| currentRoomId m
currentRoomId : Model -> Maybe RoomId
currentRoomId m = case m.route of
Room r -> Just r

78
src/Scylla/Room.elm
View File

@ -2,11 +2,13 @@ module Scylla.Room exposing (..)
import Scylla.Route exposing (RoomId)
import Scylla.Sync exposing (SyncResponse)
import Scylla.Login exposing (Username)
import Scylla.UserData exposing (UserData)
import Scylla.UserData exposing (UserData, getDisplayName)
import Scylla.Sync exposing (HistoryResponse)
import Scylla.Sync.Events exposing (MessageEvent, StateEvent, toStateEvent, toMessageEvent)
import Scylla.Sync.AccountData exposing (AccountData, getDirectMessages)
import Scylla.Sync.AccountData exposing (AccountData, getDirectMessages, applyAccountData)
import Scylla.Sync.Rooms exposing (JoinedRoom, UnreadNotificationCounts, Ephemeral)
import Json.Decode as Decode exposing (Decoder, Value, decodeValue)
import Scylla.ListUtils exposing (findFirst, uniqueBy)
import Json.Decode as Decode exposing (Decoder, Value, decodeValue, field, string, list)
import Dict exposing (Dict)
type alias RoomState = Dict (String, String) Value
@ -17,6 +19,7 @@ type alias RoomData =
, accountData : AccountData
, ephemeral : Ephemeral
, unreadNotifications : UnreadNotificationCounts
, prevHistoryBatch : Maybe String
, text : String
}
@ -35,6 +38,7 @@ emptyRoomData =
{ highlightCount = Just 0
, notificationCount = Just 0
}
, prevHistoryBatch = Nothing
, text = ""
}
@ -59,16 +63,6 @@ changeRoomState jr rs =
|> changeRoomStateEvents stateDiff
|> changeRoomStateEvents timelineDiff
changeAccountData : JoinedRoom -> AccountData -> AccountData
changeAccountData jr ad =
case jr.accountData of
Nothing -> ad
Just newAd ->
case (newAd.events, ad.events) of
(Just es, Nothing) -> newAd
(Just newEs, Just es) -> { events = Just (newEs ++ es) }
_ -> ad
changeTimeline : JoinedRoom -> List (MessageEvent) -> List (MessageEvent)
changeTimeline jr tl =
let
@ -77,7 +71,7 @@ changeTimeline jr tl =
|> Maybe.map (List.filterMap toMessageEvent)
|> Maybe.withDefault []
in
newMessages ++ tl
tl ++ newMessages
changeEphemeral : JoinedRoom -> Ephemeral -> Ephemeral
changeEphemeral jr e = Maybe.withDefault e jr.ephemeral
@ -87,11 +81,12 @@ changeNotifications jr un = Maybe.withDefault un jr.unreadNotifications
changeRoomData : JoinedRoom -> RoomData -> RoomData
changeRoomData jr rd =
{ rd | accountData = changeAccountData jr rd.accountData
{ rd | accountData = applyAccountData jr.accountData rd.accountData
, roomState = changeRoomState jr rd.roomState
, messages = changeTimeline jr rd.messages
, ephemeral = changeEphemeral jr rd.ephemeral
, unreadNotifications = changeNotifications jr rd.unreadNotifications
, prevHistoryBatch = Maybe.andThen .prevBatch jr.timeline
}
updateRoomData : JoinedRoom -> Maybe RoomData -> Maybe RoomData
@ -111,18 +106,63 @@ applySync sr or =
in
Dict.foldl applyJoinedRoom or joinedRooms
addHistoryRoomData : HistoryResponse -> Maybe RoomData -> Maybe RoomData
addHistoryRoomData hr = Maybe.map
(\rd ->
{ rd | messages = uniqueBy .eventId
<| (List.reverse <| List.filterMap toMessageEvent hr.chunk) ++ rd.messages
, prevHistoryBatch = Just hr.end
})
applyHistoryResponse : RoomId -> HistoryResponse -> OpenRooms -> OpenRooms
applyHistoryResponse rid hr = Dict.update rid (addHistoryRoomData hr)
getStateData : (String, String) -> Decoder a -> RoomData -> Maybe a
getStateData k d rd = Dict.get k rd.roomState
|> Maybe.andThen (Result.toMaybe << decodeValue d)
getRoomName : Maybe AccountData -> Dict Username UserData -> RoomId -> RoomData -> String
getEphemeralData : String -> Decoder a -> RoomData -> Maybe a
getEphemeralData k d rd = rd.ephemeral.events
|> Maybe.andThen (findFirst ((==) k << .type_))
|> Maybe.andThen (Result.toMaybe << decodeValue d << .content)
getRoomTypingUsers : RoomData -> List String
getRoomTypingUsers = Maybe.withDefault []
<< getEphemeralData "m.typing" (field "user_ids" (list string))
getRoomName : AccountData -> Dict Username UserData -> RoomId -> RoomData -> String
getRoomName ad ud rid rd =
let
customName = getStateData ("m.room.name", "") Decode.string rd
direct = Maybe.andThen getDirectMessages ad
customName = getStateData ("m.room.name", "") (field "name" (string)) rd
direct = getDirectMessages ad
|> Maybe.andThen (Dict.get rid)
in
case (customName, direct) of
(Just cn, _) -> cn
(_, Just d) -> d
(_, Just d) -> getDisplayName ud d
_ -> rid
getRoomNotificationCount : RoomData -> (Int, Int)
getRoomNotificationCount rd =
( Maybe.withDefault 0 rd.unreadNotifications.notificationCount
, Maybe.withDefault 0 rd.unreadNotifications.highlightCount
)
getTotalNotificationCount : OpenRooms -> (Int, Int)
getTotalNotificationCount =
let
sumTuples (x1, y1) (x2, y2) = (x1+x2, y1+y2)
in
Dict.foldl (\_ -> sumTuples << getRoomNotificationCount) (0, 0)
getTotalNotificationCountString : OpenRooms -> Maybe String
getTotalNotificationCountString or =
let
(n, h) = getTotalNotificationCount or
suffix = case h of
0 -> ""
_ -> "!"
in
case n of
0 -> Nothing
_ -> Just <| "(" ++ String.fromInt n ++ suffix ++ ")"

9
src/Scylla/Sync.elm
View File

@ -178,15 +178,6 @@ appendHistoryResponse sr r hr =
{ sr | rooms = newRooms }
-- Business Logic: Names
senderName : String -> String
senderName s =
let
colonIndex = Maybe.withDefault -1
<| List.head
<| String.indexes ":" s
in
String.slice 1 colonIndex s
homeserver : String -> String
homeserver s =
let

10
src/Scylla/Sync/AccountData.elm
View File

@ -30,6 +30,16 @@ invertDirectMessages dmr =
Dict.empty
dmr
applyAccountData : Maybe AccountData -> AccountData -> AccountData
applyAccountData mad ad =
case mad of
Nothing -> ad
Just newAd ->
case (newAd.events, ad.events) of
(Just es, Nothing) -> newAd
(Just newEs, Just es) -> { events = Just (newEs ++ es) }
_ -> ad
getAccountData : String -> Decode.Decoder a -> AccountData -> Maybe a
getAccountData key d ad = ad.events
|> Maybe.andThen (findFirst ((==) key << .type_))

17
src/Scylla/UserData.elm
View File

@ -1,6 +1,8 @@
module Scylla.UserData exposing (..)
import Scylla.Login exposing (Username)
import Json.Decode as Decode exposing (Decoder, int, string, float, list, value, dict, bool, field)
import Json.Decode.Pipeline exposing (required, optional)
import Dict exposing (Dict)
type alias UserData =
{ displayName : Maybe String
@ -12,3 +14,18 @@ userDataDecoder =
Decode.succeed UserData
|> optional "displayname" (Decode.map Just string) Nothing
|> optional "avatar_url" (Decode.map Just string) Nothing
getDisplayName : Dict Username UserData -> Username -> String
getDisplayName ud s = Dict.get s ud
|> Maybe.andThen .displayName
|> Maybe.withDefault (getSenderName s)
getSenderName : Username -> String
getSenderName s =
let
colonIndex = Maybe.withDefault -1
<| List.head
<| String.indexes ":" s
in
String.slice 1 colonIndex s

42
src/Scylla/Views.elm
View File

@ -3,12 +3,12 @@ import Scylla.Model exposing (..)
import Scylla.Sync exposing (..)
import Scylla.Sync.Events exposing (..)
import Scylla.Sync.Rooms exposing (..)
import Scylla.Room exposing (RoomData, emptyOpenRooms, getRoomName)
import Scylla.Room exposing (RoomData, emptyOpenRooms, getRoomName, getRoomTypingUsers)
import Scylla.Route exposing (..)
import Scylla.Fnv as Fnv
import Scylla.Messages exposing (..)
import Scylla.Login exposing (Username)
import Scylla.UserData exposing (UserData)
import Scylla.UserData exposing (UserData, getDisplayName)
import Scylla.Http exposing (fullMediaUrl)
import Scylla.Api exposing (ApiUrl)
import Scylla.ListUtils exposing (groupBy)
@ -48,10 +48,8 @@ stringColor s =
viewFull : Model -> List (Html Msg)
viewFull model =
let
room r = Maybe.map (\jr -> (r, jr))
<| Maybe.andThen (Dict.get r)
<| Maybe.andThen .join
<| model.sync.rooms
room r = Dict.get r model.rooms
|> Maybe.map (\rd -> (r, rd))
core = case model.route of
Login -> loginView model
Base -> baseView model Nothing
@ -67,10 +65,10 @@ errorsView = div [ class "errors-wrapper" ] << List.indexedMap errorView
errorView : Int -> String -> Html Msg
errorView i s = div [ class "error-wrapper", onClick <| DismissError i ] [ iconView "alert-triangle", text s ]
baseView : Model -> Maybe (RoomId, JoinedRoom) -> Html Msg
baseView m jr =
baseView : Model -> Maybe (RoomId, RoomData) -> Html Msg
baseView m rd =
let
roomView = Maybe.map (\(id, r) -> joinedRoomView m id r) jr
roomView = Maybe.map (\(id, r) -> joinedRoomView m id r) rd
reconnect = reconnectView m
in
div [ class "base-wrapper" ] <| maybeHtml
@ -113,14 +111,14 @@ homeserverView m hs rs =
let
roomList = div [ class "rooms-list" ]
<| List.map (\(rid, r) -> roomListElementView m rid r)
<| List.sortBy (\(rid, r) -> getRoomName m.sync.accountData m.userData rid r) rs
<| List.sortBy (\(rid, r) -> getRoomName m.accountData m.userData rid r) rs
in
div [ class "homeserver-wrapper" ] [ h3 [] [ text hs ], roomList ]
roomListElementView : Model -> RoomId -> RoomData -> Html Msg
roomListElementView m rid rd =
let
name = getRoomName m.sync.accountData m.userData rid rd
name = getRoomName m.accountData m.userData rid rd
isVisible = m.searchText == "" || (String.contains (String.toLower m.searchText) <| String.toLower name)
isCurrentRoom = case currentRoomId m of
Nothing -> False
@ -160,10 +158,10 @@ loginView m = div [ class "login-wrapper" ]
, button [ onClick AttemptLogin ] [ text "Log In" ]
]
joinedRoomView : Model -> RoomId -> JoinedRoom -> Html Msg
joinedRoomView m roomId jr =
joinedRoomView : Model -> RoomId -> RoomData -> Html Msg
joinedRoomView m roomId rd =
let
typing = List.map (displayName m.userData) <| roomTypingUsers jr
typing = List.map (getDisplayName m.userData) <| getRoomTypingUsers rd
typingText = String.join ", " typing
typingSuffix = case List.length typing of
0 -> ""
@ -184,18 +182,16 @@ joinedRoomView m roomId jr =
]
in
div [ class "room-wrapper" ]
[ h2 [] [ text <| roomDisplayName m.roomNames roomId ]
, lazy6 lazyMessagesView m.userData roomId jr m.apiUrl m.loginUsername m.sending
[ h2 [] [ text <| getRoomName m.accountData m.userData roomId rd ]
, lazy6 lazyMessagesView m.userData roomId rd m.apiUrl m.loginUsername m.sending
, messageInput
, typingWrapper
]
lazyMessagesView : Dict String UserData -> RoomId -> JoinedRoom -> ApiUrl -> Username -> Dict Int (RoomId, SendingMessage) -> Html Msg
lazyMessagesView ud rid jr au lu snd =
lazyMessagesView : Dict String UserData -> RoomId -> RoomData -> ApiUrl -> Username -> Dict Int (RoomId, SendingMessage) -> Html Msg
lazyMessagesView ud rid rd au lu snd =
let
roomReceived = receivedMessagesRoom
<| Maybe.withDefault []
<| Maybe.andThen .events jr.timeline
roomReceived = receivedMessagesRoom rd
roomSending = sendingMessagesRoom rid snd
renderedMessages = List.map (userMessagesView ud au)
<| mergeMessages lu
@ -230,7 +226,7 @@ messagesWrapperView rid es = div [ class "messages-wrapper", id "messages-wrappe
senderView : Dict String UserData -> Username -> Html Msg
senderView ud s =
span [ style "color" <| stringColor s, class "sender-wrapper" ] [ text <| displayName ud s ]
span [ style "color" <| stringColor s, class "sender-wrapper" ] [ text <| getDisplayName ud s ]
userMessagesView : Dict String UserData -> ApiUrl -> (Username, List Message) -> Html Msg
userMessagesView ud apiUrl (u, ms) =
@ -284,7 +280,7 @@ roomEventContent f re =
roomEventEmoteView : Dict String UserData -> MessageEvent -> Maybe (Html Msg)
roomEventEmoteView ud re =
let
emoteText = "* " ++ displayName ud re.sender ++ " "
emoteText = "* " ++ getDisplayName ud re.sender ++ " "
in
roomEventContent (\cs -> span [] (text emoteText :: cs)) re