Compare commits

..

No commits in common. "3b1dabd624f971f9bb3de42cf5f01bd2aa5d23f3" and "db2def5388092c52b40bebf743b5a7ba0131ab32" have entirely different histories.

7 changed files with 74 additions and 57 deletions

View File

@ -111,12 +111,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 (userData 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,14 +173,15 @@ 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 let
userDataCmd h = newUsersCmd m newUsersCmd h = Cmd.batch
<| List.map (userData m.apiUrl (Maybe.withDefault "" m.token))
<| newUsers m <| newUsers m
<| uniqueBy identity <| uniqueBy (\s -> s)
<| List.map .sender <| List.map .sender
<| h.chunk <| h.chunk
in in
case hr of case hr of
Ok h -> ({ m | sync = appendHistoryResponse m.sync r h }, userDataCmd h) Ok h -> ({ m | sync = appendHistoryResponse m.sync r h }, newUsersCmd h)
Err _ -> ({ m | errors = "Unable to load older history from server"::m.errors }, Cmd.none) 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)
@ -312,7 +307,9 @@ updateSyncResponse model r notify =
nextBatch = Result.withDefault model.sync.nextBatch nextBatch = Result.withDefault model.sync.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 newUserCmd sr = Cmd.batch
<| List.map (userData model.apiUrl
<| Maybe.withDefault "" model.token)
<| newUsers model <| newUsers model
<| allUsers sr <| allUsers sr
notification sr = findFirstBy notification sr = findFirstBy
@ -357,7 +354,7 @@ updateSyncResponse model r notify =
Ok sr -> (newModel sr Ok sr -> (newModel sr
, Cmd.batch , Cmd.batch
[ syncCmd [ syncCmd
, userDataCmd sr , newUserCmd sr
, notificationCmd sr , notificationCmd sr
, setScrollCmd sr , setScrollCmd sr
, setReadReceiptCmd sr , setReadReceiptCmd sr

View File

@ -1,21 +1,30 @@
module Scylla.AccountData exposing (..) module Scylla.AccountData exposing (..)
import Scylla.Sync exposing (SyncResponse, AccountData, JoinedRoom, roomAccountData) import Scylla.Sync exposing (SyncResponse, AccountData, JoinedRoom, roomAccountData)
import Json.Decode as Decode import Json.Decode as Decode
import Json.Encode as Encode import Dict
import Dict exposing (Dict)
type alias DirectMessages = Dict String String type NotificationSetting = Normal | MentionsOnly | None
type alias DirectMessagesRaw = Dict String (List String)
directMessagesDecoder : Decode.Decoder DirectMessages notificationSettingDecoder : Decode.Decoder NotificationSetting
directMessagesDecoder = notificationSettingDecoder =
Decode.dict (Decode.list Decode.string) let
|> Decode.map (invertDirectMessages) checkString s = case s of
"Normal" -> Decode.succeed Normal
"MentionsOnly" -> Decode.succeed MentionsOnly
"None" -> Decode.succeed None
_ -> Decode.fail "Not a valid notification setting"
in
Decode.andThen checkString Decode.string
invertDirectMessages : DirectMessagesRaw -> DirectMessages roomNotificationSetting : JoinedRoom -> NotificationSetting
invertDirectMessages dmr = roomNotificationSetting jr = Maybe.withDefault Normal
Dict.foldl <| Maybe.andThen Result.toMaybe
(\k lv acc -> List.foldl (\v -> Dict.insert v k) acc lv) <| Maybe.map (Decode.decodeValue notificationSettingDecoder)
Dict.empty <| roomAccountData jr "com.danilafe.scylla.notifications"
dmr
roomIdNotificationSetting : SyncResponse -> String -> NotificationSetting
roomIdNotificationSetting sr s = Maybe.withDefault Normal
<| Maybe.map roomNotificationSetting
<| Maybe.andThen (Dict.get s)
<| Maybe.andThen .join sr.rooms

View File

@ -149,7 +149,7 @@ userData apiUrl token username = request
, tracker = Nothing , tracker = Nothing
} }
setReadMarkers : ApiUrl -> ApiToken -> RoomId -> String -> Maybe String -> Cmd Msg setReadMarkers : ApiUrl -> ApiToken -> String -> RoomId -> Maybe String -> Cmd Msg
setReadMarkers apiUrl token roomId fullyRead readReceipt = setReadMarkers apiUrl token roomId fullyRead readReceipt =
let let
readReciptFields = case readReceipt of readReciptFields = case readReceipt of
@ -176,14 +176,3 @@ sendTypingIndicator apiUrl token room user isTyping timeout = request
, timeout = Nothing , timeout = Nothing
, tracker = Nothing , tracker = Nothing
} }
setRoomAccountData : ApiUrl -> ApiToken -> Username -> RoomId -> String -> Decode.Value -> Msg -> Cmd Msg
setRoomAccountData apiUrl token user roomId key value msg = request
{ method = "PUT"
, headers = authenticatedHeaders token
, url = (fullClientUrl apiUrl) ++ "/user/" ++ user ++ "/rooms/" ++ roomId ++ "/account_data/" ++ key
, body = jsonBody value
, expect = expectWhatever (\_ -> msg)
, timeout = Nothing
, tracker = Nothing
}

View File

@ -1,7 +1,6 @@
module Scylla.Model exposing (..) module Scylla.Model exposing (..)
import Scylla.Api exposing (..) import Scylla.Api exposing (..)
import Scylla.Sync exposing (SyncResponse, HistoryResponse, JoinedRoom, senderName, roomName, roomJoinedUsers, findFirst, AccountData) import Scylla.Sync exposing (SyncResponse, HistoryResponse, JoinedRoom, senderName, roomName, roomJoinedUsers, findFirst, directMessagesDecoder, AccountData)
import Scylla.AccountData exposing (directMessagesDecoder)
import Scylla.Login exposing (LoginResponse, Username, Password) import Scylla.Login exposing (LoginResponse, Username, Password)
import Scylla.UserData exposing (UserData) import Scylla.UserData exposing (UserData)
import Scylla.Route exposing (Route(..), RoomId) import Scylla.Route exposing (Route(..), RoomId)
@ -60,25 +59,25 @@ type Msg =
| TypingTick Posix -- Tick for updating the typing status | TypingTick Posix -- Tick for updating the typing status
| History RoomId -- Load history for a room | History RoomId -- Load history for a room
| ReceiveHistoryResponse RoomId (Result Http.Error HistoryResponse) -- HTTP, receive history | ReceiveHistoryResponse RoomId (Result Http.Error HistoryResponse) -- HTTP, receive history
| SendImages RoomId -- Image selection triggered | SendImages RoomId
| SendFiles RoomId -- File selection triggered | SendFiles RoomId
| ImagesSelected RoomId File (List File) -- Images to send selected | ImagesSelected RoomId File (List File)
| FilesSelected RoomId File (List File) -- Files to send selected | FilesSelected RoomId File (List File)
| ImageUploadComplete RoomId File (Result Http.Error String) -- Image has been uploaded | ImageUploadComplete RoomId File (Result Http.Error String)
| FileUploadComplete RoomId File (Result Http.Error String) -- File has been uploaded | FileUploadComplete RoomId File (Result Http.Error String)
| SendImageResponse (Result Http.Error String) -- Server responded to image | SendImageResponse (Result Http.Error String)
| SendFileResponse (Result Http.Error String) -- Server responded to file | SendFileResponse (Result Http.Error String)
| ReceiveMarkdown MarkdownResponse -- Markdown was rendered | ReceiveMarkdown MarkdownResponse
| DismissError Int -- User dismisses error | DismissError Int
| AttemptReconnect -- User wants to reconnect to server | AttemptReconnect
| UpdateSearchText String -- Change search text in room list | UpdateSearchText String
displayName : Dict String UserData -> Username -> String displayName : Dict String UserData -> Username -> String
displayName ud s = Maybe.withDefault (senderName s) <| Maybe.andThen .displayName <| Dict.get s ud displayName ud s = Maybe.withDefault (senderName s) <| Maybe.andThen .displayName <| Dict.get s ud
roomDisplayName : Dict RoomId String -> RoomId -> String roomDisplayName : Model -> RoomId -> String
roomDisplayName rd rid = roomDisplayName m rid =
Maybe.withDefault "<No Name>" <| Dict.get rid rd Maybe.withDefault "<No Name>" <| Dict.get rid m.roomNames
computeRoomDisplayName : Dict String UserData -> Maybe AccountData -> RoomId -> JoinedRoom -> Maybe String computeRoomDisplayName : Dict String UserData -> Maybe AccountData -> RoomId -> JoinedRoom -> Maybe String
computeRoomDisplayName ud ad rid jr = computeRoomDisplayName ud ad rid jr =

View File

@ -13,6 +13,12 @@ type alias Notification =
port sendNotificationPort : Notification -> Cmd msg port sendNotificationPort : Notification -> Cmd msg
port onNotificationClickPort : (String -> msg) -> Sub msg port onNotificationClickPort : (String -> msg) -> Sub msg
producesNotification : NotificationSetting -> RoomEvent -> Bool
producesNotification ns re = case ns of
Normal -> True
_ -> False
notificationText : RoomEvent -> String notificationText : RoomEvent -> String
notificationText re = case (Decode.decodeValue (field "msgtype" string) re.content) of notificationText re = case (Decode.decodeValue (field "msgtype" string) re.content) of
Ok "m.text" -> Result.withDefault "" <| (Decode.decodeValue (field "body" string) re.content) Ok "m.text" -> Result.withDefault "" <| (Decode.decodeValue (field "body" string) re.content)
@ -25,5 +31,6 @@ joinedRoomNotificationEvents s =
in in
List.sortBy (\(k, v) -> v.originServerTs) List.sortBy (\(k, v) -> v.originServerTs)
<| Dict.foldl (\k v a -> a ++ applyPair k v) [] <| Dict.foldl (\k v a -> a ++ applyPair k v) []
<| Dict.map (\k v -> List.filter (producesNotification (roomIdNotificationSetting s k)) v)
<| joinedRoomsTimelineEvents s <| joinedRoomsTimelineEvents s

View File

@ -258,6 +258,22 @@ historyResponseDecoder =
|> required "end" string |> required "end" string
|> required "chunk" (list roomEventDecoder) |> required "chunk" (list roomEventDecoder)
-- Direct Messages
type alias DirectMessages = Dict String String
type alias DirectMessagesRaw = Dict String (List String)
directMessagesDecoder : Decoder DirectMessages
directMessagesDecoder =
Decode.dict (Decode.list Decode.string)
|> Decode.map (invertDirectMessages)
invertDirectMessages : DirectMessagesRaw -> DirectMessages
invertDirectMessages dmr =
Dict.foldl
(\k lv acc -> List.foldl (\v -> Dict.insert v k) acc lv)
Dict.empty
dmr
-- Business Logic: Helper Functions -- Business Logic: Helper Functions
groupBy : (a -> comparable) -> List a -> Dict comparable (List a) groupBy : (a -> comparable) -> List a -> Dict comparable (List a)
groupBy f xs = groupBy f xs =

View File

@ -112,14 +112,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) -> roomDisplayName m.roomNames rid) rs <| List.sortBy (\(rid, r) -> roomDisplayName m rid) rs
in in
div [ class "homeserver-wrapper" ] [ h3 [] [ text hs ], roomList ] div [ class "homeserver-wrapper" ] [ h3 [] [ text hs ], roomList ]
roomListElementView : Model -> RoomId -> JoinedRoom -> Html Msg roomListElementView : Model -> RoomId -> JoinedRoom -> Html Msg
roomListElementView m rid jr = roomListElementView m rid jr =
let let
name = roomDisplayName m.roomNames rid name = roomDisplayName m rid
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
@ -183,7 +183,7 @@ joinedRoomView m roomId jr =
] ]
in in
div [ class "room-wrapper" ] div [ class "room-wrapper" ]
[ h2 [] [ text <| roomDisplayName m.roomNames roomId ] [ h2 [] [ text <| roomDisplayName m roomId ]
, lazy6 lazyMessagesView m.userData roomId jr m.apiUrl m.loginUsername m.sending , lazy6 lazyMessagesView m.userData roomId jr m.apiUrl m.loginUsername m.sending
, messageInput , messageInput
, typingWrapper , typingWrapper