Compare commits

...

5 Commits

7 changed files with 57 additions and 74 deletions

View File

@ -111,6 +111,12 @@ 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
@ -173,15 +179,14 @@ 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
newUsersCmd h = Cmd.batch userDataCmd h = newUsersCmd m
<| List.map (userData m.apiUrl (Maybe.withDefault "" m.token))
<| newUsers m <| newUsers m
<| uniqueBy (\s -> s) <| uniqueBy identity
<| 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 }, newUsersCmd h) Ok h -> ({ m | sync = appendHistoryResponse m.sync r h }, userDataCmd 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)
@ -307,9 +312,7 @@ 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
newUserCmd sr = Cmd.batch userDataCmd sr = newUsersCmd model
<| List.map (userData model.apiUrl
<| Maybe.withDefault "" model.token)
<| newUsers model <| newUsers model
<| allUsers sr <| allUsers sr
notification sr = findFirstBy notification sr = findFirstBy
@ -354,7 +357,7 @@ updateSyncResponse model r notify =
Ok sr -> (newModel sr Ok sr -> (newModel sr
, Cmd.batch , Cmd.batch
[ syncCmd [ syncCmd
, newUserCmd sr , userDataCmd sr
, notificationCmd sr , notificationCmd sr
, setScrollCmd sr , setScrollCmd sr
, setReadReceiptCmd sr , setReadReceiptCmd sr

View File

@ -1,30 +1,21 @@
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 Dict import Json.Encode as Encode
import Dict exposing (Dict)
type NotificationSetting = Normal | MentionsOnly | None type alias DirectMessages = Dict String String
type alias DirectMessagesRaw = Dict String (List String)
notificationSettingDecoder : Decode.Decoder NotificationSetting directMessagesDecoder : Decode.Decoder DirectMessages
notificationSettingDecoder = directMessagesDecoder =
let Decode.dict (Decode.list Decode.string)
checkString s = case s of |> Decode.map (invertDirectMessages)
"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
roomNotificationSetting : JoinedRoom -> NotificationSetting invertDirectMessages : DirectMessagesRaw -> DirectMessages
roomNotificationSetting jr = Maybe.withDefault Normal invertDirectMessages dmr =
<| Maybe.andThen Result.toMaybe Dict.foldl
<| Maybe.map (Decode.decodeValue notificationSettingDecoder) (\k lv acc -> List.foldl (\v -> Dict.insert v k) acc lv)
<| roomAccountData jr "com.danilafe.scylla.notifications" Dict.empty
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 -> String -> RoomId -> Maybe String -> Cmd Msg setReadMarkers : ApiUrl -> ApiToken -> RoomId -> String -> 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,3 +176,14 @@ 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,6 +1,7 @@
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, directMessagesDecoder, AccountData) import Scylla.Sync exposing (SyncResponse, HistoryResponse, JoinedRoom, senderName, roomName, roomJoinedUsers, findFirst, 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)
@ -59,25 +60,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 | SendImages RoomId -- Image selection triggered
| SendFiles RoomId | SendFiles RoomId -- File selection triggered
| ImagesSelected RoomId File (List File) | ImagesSelected RoomId File (List File) -- Images to send selected
| FilesSelected RoomId File (List File) | FilesSelected RoomId File (List File) -- Files to send selected
| ImageUploadComplete RoomId File (Result Http.Error String) | ImageUploadComplete RoomId File (Result Http.Error String) -- Image has been uploaded
| FileUploadComplete RoomId File (Result Http.Error String) | FileUploadComplete RoomId File (Result Http.Error String) -- File has been uploaded
| SendImageResponse (Result Http.Error String) | SendImageResponse (Result Http.Error String) -- Server responded to image
| SendFileResponse (Result Http.Error String) | SendFileResponse (Result Http.Error String) -- Server responded to file
| ReceiveMarkdown MarkdownResponse | ReceiveMarkdown MarkdownResponse -- Markdown was rendered
| DismissError Int | DismissError Int -- User dismisses error
| AttemptReconnect | AttemptReconnect -- User wants to reconnect to server
| UpdateSearchText String | UpdateSearchText String -- Change search text in room list
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 : Model -> RoomId -> String roomDisplayName : Dict RoomId String -> RoomId -> String
roomDisplayName m rid = roomDisplayName rd rid =
Maybe.withDefault "<No Name>" <| Dict.get rid m.roomNames Maybe.withDefault "<No Name>" <| Dict.get rid rd
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,12 +13,6 @@ 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)
@ -31,6 +25,5 @@ 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,22 +258,6 @@ 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 rid) rs <| List.sortBy (\(rid, r) -> roomDisplayName m.roomNames 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 rid name = roomDisplayName m.roomNames 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 roomId ] [ h2 [] [ text <| roomDisplayName m.roomNames 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