Compare commits

..

8 Commits

17 changed files with 493 additions and 112 deletions

77
elm-dependencies.nix Normal file
View File

@@ -0,0 +1,77 @@
{
"NoRedInk/elm-json-decode-pipeline" = {
sha256 = "0y25xn0yx1q2xlg1yx1i0hg4xq1yxx6yfa99g272z8162si75hnl";
version = "1.0.0";
};
"elm/browser" = {
sha256 = "1zlmx672glg7fdgkvh5jm47y85pv7pdfr5mkhg6x7ar6k000vyka";
version = "1.0.1";
};
"elm/core" = {
sha256 = "1l0qdbczw91kzz8sx5d5zwz9x662bspy7p21dsr3f2rigxiix2as";
version = "1.0.2";
};
"elm/file" = {
sha256 = "15vw1ilbg0msimq2k9magwigp8lwqrgvz3vk6qia6b3ldahvw8jr";
version = "1.0.1";
};
"elm/html" = {
sha256 = "1n3gpzmpqqdsldys4ipgyl1zacn0kbpc3g4v3hdpiyfjlgh8bf3k";
version = "1.0.0";
};
"elm/http" = {
sha256 = "008bs76mnp48b4dw8qwjj4fyvzbxvlrl4xpa2qh1gg2kfwyw56v1";
version = "2.0.0";
};
"elm/json" = {
sha256 = "1a107nmm905dih4w4mjjkkpdcjbgaf5qjvr7fl30kkpkckfjjnrw";
version = "1.1.2";
};
"elm/svg" = {
sha256 = "1cwcj73p61q45wqwgqvrvz3aypjyy3fw732xyxdyj6s256hwkn0k";
version = "1.0.1";
};
"elm/time" = {
sha256 = "0vch7i86vn0x8b850w1p69vplll1bnbkp8s383z7pinyg94cm2z1";
version = "1.0.0";
};
"elm/url" = {
sha256 = "0av8x5syid40sgpl5vd7pry2rq0q4pga28b4yykn9gd9v12rs3l4";
version = "1.0.0";
};
"hecrj/html-parser" = {
sha256 = "0pla6hswsl9piwrj3yl4pc4nfs5adc4g4c93644j4xila7bqqg8a";
version = "2.0.0";
};
"elm/bytes" = {
sha256 = "040d7irrawcbnq9jxhzx8p9qacdlw5bncy6lgndd6inm53rvvwbp";
version = "1.0.7";
};
"elm/parser" = {
sha256 = "0a3cxrvbm7mwg9ykynhp7vjid58zsw03r63qxipxp3z09qks7512";
version = "1.1.0";
};
"elm/virtual-dom" = {
sha256 = "0q1v5gi4g336bzz1lgwpn5b1639lrn63d8y6k6pimcyismp2i1yg";
version = "1.0.2";
};
"rtfeldman/elm-hex" = {
sha256 = "1y0aa16asvwdqmgbskh5iba6psp43lkcjjw9mgzj3gsrg33lp00d";
version = "1.0.0";
};
}

View File

@@ -3,7 +3,7 @@
"source-directories": [ "source-directories": [
"src" "src"
], ],
"elm-version": "0.19.0", "elm-version": "0.19.1",
"dependencies": { "dependencies": {
"direct": { "direct": {
"NoRedInk/elm-json-decode-pipeline": "1.0.0", "NoRedInk/elm-json-decode-pipeline": "1.0.0",

56
elm.nix Normal file
View File

@@ -0,0 +1,56 @@
{ lib, stdenv, elm, fetchElmDeps, uglify-js, sass }:
let
mkDerivation =
{ srcs ? ./elm-dependencies.nix
, src
, name
, srcdir ? "./src"
, targets ? []
, registryDat ? ./registry.dat
, outputJavaScript ? false
}:
stdenv.mkDerivation {
inherit name src;
buildInputs = [ elm sass ]
++ lib.optional outputJavaScript uglify-js;
buildPhase = fetchElmDeps {
elmPackages = import srcs;
elmVersion = "0.19.1";
inherit registryDat;
};
installPhase = let
elmfile = module: "${srcdir}/${builtins.replaceStrings ["."] ["/"] module}.elm";
extension = if outputJavaScript then "js" else "html";
in ''
${lib.concatStrings (map (module: ''
echo "compiling ${elmfile module}"
elm make ${elmfile module} --optimize --output $out/${module}.${extension}
${lib.optionalString outputJavaScript ''
echo "minifying ${elmfile module}"
uglifyjs $out/${module}.${extension} --compress 'pure_funcs="F2,F3,F4,F5,F6,F7,F8,F9,A2,A3,A4,A5,A6,A7,A8,A9",pure_getters,keep_fargs=false,unsafe_comps,unsafe' \
| uglifyjs --mangle --output $out/${module}.min.${extension}
''}
'') targets)}
# Custom logic for Scylla in particular
mkdir $out/static $out/static/js $out/static/css $out/static/svg
cp $src/index.html $out/index.html
cp $out/Main.min.js $out/static/js/elm.js
cp $src/static/js/*.js $out/static/js
cp $src/static/svg/*.svg $out/static/svg
sass $src/static/scss/style.scss $out/static/css/style.css
'';
};
in mkDerivation {
name = "Scylla-0.1.0";
srcs = ./elm-dependencies.nix;
src = ./.;
targets = ["Main"];
srcdir = "./src";
outputJavaScript = true;
}

61
flake.lock generated Normal file
View File

@@ -0,0 +1,61 @@
{
"nodes": {
"flake-utils": {
"inputs": {
"systems": "systems"
},
"locked": {
"lastModified": 1731533236,
"narHash": "sha256-l0KFg5HjrsfsO/JpG+r7fRrqm12kzFHyUHqHCVpMMbI=",
"owner": "numtide",
"repo": "flake-utils",
"rev": "11707dc2f618dd54ca8739b309ec4fc024de578b",
"type": "github"
},
"original": {
"owner": "numtide",
"repo": "flake-utils",
"type": "github"
}
},
"nixpkgs": {
"locked": {
"lastModified": 1766736597,
"narHash": "sha256-BASnpCLodmgiVn0M1MU2Pqyoz0aHwar/0qLkp7CjvSQ=",
"owner": "nixos",
"repo": "nixpkgs",
"rev": "f560ccec6b1116b22e6ed15f4c510997d99d5852",
"type": "github"
},
"original": {
"owner": "nixos",
"ref": "nixos-25.11",
"repo": "nixpkgs",
"type": "github"
}
},
"root": {
"inputs": {
"flake-utils": "flake-utils",
"nixpkgs": "nixpkgs"
}
},
"systems": {
"locked": {
"lastModified": 1681028828,
"narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=",
"owner": "nix-systems",
"repo": "default",
"rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e",
"type": "github"
},
"original": {
"owner": "nix-systems",
"repo": "default",
"type": "github"
}
}
},
"root": "root",
"version": 7
}

23
flake.nix Normal file
View File

@@ -0,0 +1,23 @@
{
inputs = {
nixpkgs.url = "github:nixos/nixpkgs/nixos-25.11";
flake-utils.url = "github:numtide/flake-utils";
};
outputs = { self, nixpkgs, flake-utils }:
flake-utils.lib.eachDefaultSystem (
system:
let
pkgs = import nixpkgs { inherit system; };
Scylla = import ./elm.nix {
inherit (pkgs) lib stdenv sass;
inherit (pkgs.elmPackages) fetchElmDeps elm;
inherit (pkgs.nodePackages) uglify-js;
};
in
{
packages = { inherit Scylla; };
defaultPackage = Scylla;
}
);
}

BIN
registry.dat Normal file

Binary file not shown.

View File

@@ -1,3 +1,4 @@
module Main exposing (..)
import Browser exposing (application, UrlRequest(..)) import Browser exposing (application, UrlRequest(..))
import Browser.Navigation as Nav import Browser.Navigation as Nav
import Browser.Dom exposing (Viewport, setViewportOf) import Browser.Dom exposing (Viewport, setViewportOf)
@@ -5,6 +6,7 @@ import Scylla.Room exposing (OpenRooms, applySync)
import Scylla.Sync exposing (..) import Scylla.Sync exposing (..)
import Scylla.Sync.Events exposing (toMessageEvent, getType, getSender, getUnsigned) import Scylla.Sync.Events exposing (toMessageEvent, getType, getSender, getUnsigned)
import Scylla.Sync.AccountData exposing (..) import Scylla.Sync.AccountData exposing (..)
import Scylla.Sync.Push exposing (..)
import Scylla.ListUtils exposing (..) import Scylla.ListUtils exposing (..)
import Scylla.Messages exposing (..) import Scylla.Messages exposing (..)
import Scylla.Login exposing (..) import Scylla.Login exposing (..)
@@ -13,7 +15,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 (..)
@@ -50,8 +51,6 @@ init _ url key =
, roomText = Dict.empty , roomText = Dict.empty
, sending = Dict.empty , sending = Dict.empty
, transactionId = 0 , transactionId = 0
, userData = Dict.empty
, roomNames = Dict.empty
, connected = True , connected = True
, searchText = "" , searchText = ""
, rooms = emptyOpenRooms , rooms = emptyOpenRooms
@@ -86,7 +85,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 +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,16 +172,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 +254,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,18 +292,18 @@ 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 notification sr =
<| newUsers model getPushRuleset model.accountData
<| allUsers sr |> Maybe.map (\rs -> getNotificationEvents rs sr)
notification sr = findFirstBy |> Maybe.withDefault []
(\(s, e) -> e.originServerTs) |> findFirstBy
(\(s, e) -> e.sender /= model.loginUsername) (\(s, e) -> e.originServerTs)
<| joinedRoomNotificationEvents sr (\(s, e) -> e.sender /= model.loginUsername)
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 = notificationText e , text = getText e
, room = s , room = s
}) <| notification sr }) <| notification sr
else Cmd.none else Cmd.none
@@ -359,7 +340,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

@@ -138,8 +138,8 @@ login apiUrl username password = request
, tracker = Nothing , tracker = Nothing
} }
userData : ApiUrl -> ApiToken -> Username -> Cmd Msg getUserData : ApiUrl -> ApiToken -> Username -> Cmd Msg
userData apiUrl token username = request getUserData apiUrl token username = request
{ method = "GET" { method = "GET"
, headers = authenticatedHeaders token , headers = authenticatedHeaders token
, url = (fullClientUrl apiUrl) ++ "/profile/" ++ username , url = (fullClientUrl apiUrl) ++ "/profile/" ++ username

View File

@@ -16,13 +16,13 @@ type Message
= Sending SendingMessage = Sending SendingMessage
| Received MessageEvent | Received MessageEvent
messageUsername : Username -> Message -> Username getUsername : Username -> Message -> Username
messageUsername u msg = case msg of getUsername u msg = case msg of
Sending _ -> u Sending _ -> u
Received re -> re.sender Received re -> re.sender
mergeMessages : Username -> List Message -> List (Username, List Message) groupMessages : Username -> List Message -> List (Username, List Message)
mergeMessages du xs = groupMessages du xs =
let let
initialState = (Nothing, [], []) initialState = (Nothing, [], [])
appendNamed mu ms msl = case mu of appendNamed mu ms msl = case mu of
@@ -30,19 +30,19 @@ mergeMessages du xs =
Nothing -> msl Nothing -> msl
foldFunction msg (pu, ms, msl) = foldFunction msg (pu, ms, msl) =
let let
nu = Just <| messageUsername du msg nu = Just <| getUsername du msg
in in
if pu == nu then (pu, ms ++ [msg], msl) else (nu, [msg], appendNamed pu ms msl) if pu == nu then (pu, ms ++ [msg], msl) else (nu, [msg], appendNamed pu ms msl)
(fmu, fms, fmsl) = List.foldl foldFunction initialState xs (fmu, fms, fmsl) = List.foldl foldFunction initialState xs
in in
appendNamed fmu fms fmsl appendNamed fmu fms fmsl
receivedMessagesRoom : RoomData -> List Message getReceivedMessages : RoomData -> List Message
receivedMessagesRoom rd = rd.messages getReceivedMessages rd = rd.messages
|> List.filter (\e -> e.type_ == "m.room.message") |> List.filter (\e -> e.type_ == "m.room.message")
|> List.map Received |> List.map Received
sendingMessagesRoom : RoomId -> Dict Int (RoomId, SendingMessage) -> List Message getSendingMessages : RoomId -> Dict Int (RoomId, SendingMessage) -> List Message
sendingMessagesRoom rid ms = List.map (\(tid, (_, sm)) -> Sending sm) getSendingMessages rid ms = List.map (\(tid, (_, sm)) -> Sending sm)
<| List.filter (\(_, (nrid, _)) -> nrid == rid) <| List.filter (\(_, (nrid, _)) -> nrid == rid)
<| Dict.toList ms <| Dict.toList ms

View File

@@ -1,12 +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, getSenderName)
import Scylla.Sync.Rooms exposing (JoinedRoom) import Scylla.Sync.Rooms exposing (JoinedRoom)
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 (..)
@@ -35,8 +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
, roomNames : Dict RoomId String
, 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
_ -> getSenderName u

View File

@@ -1,6 +1,7 @@
port module Scylla.Notification exposing (..) port module Scylla.Notification exposing (..)
import Scylla.Sync exposing (SyncResponse, joinedRoomsTimelineEvents) import Scylla.Sync exposing (SyncResponse, joinedRoomsTimelineEvents)
import Scylla.Sync.Events exposing (RoomEvent, MessageEvent, toMessageEvent) import Scylla.Sync.Events exposing (RoomEvent, MessageEvent, toMessageEvent)
import Scylla.Sync.Push exposing (Ruleset, getEventNotification)
import Json.Decode as Decode exposing (string, field) import Json.Decode as Decode exposing (string, field)
import Dict import Dict
@@ -13,18 +14,19 @@ 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
notificationText : MessageEvent -> String getText : MessageEvent -> String
notificationText re = case (Decode.decodeValue (field "msgtype" string) re.content) of getText 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)
_ -> "" _ -> ""
joinedRoomNotificationEvents : SyncResponse -> List (String, MessageEvent) getNotificationEvents : Ruleset -> SyncResponse -> List (String, MessageEvent)
joinedRoomNotificationEvents s = getNotificationEvents rs s = s.rooms
let |> Maybe.andThen .join
applyPair k = List.map (\v -> (k, v)) |> Maybe.map (Dict.map (\k v -> v.timeline
in |> Maybe.andThen .events
List.sortBy (\(k, v) -> v.originServerTs) |> Maybe.map (List.filter <| getEventNotification rs k)
<| List.filterMap (\(k, e) -> Maybe.map (\me -> (k, me)) <| toMessageEvent e) |> Maybe.map (List.filterMap <| toMessageEvent)
<| Dict.foldl (\k v a -> a ++ applyPair k v) [] |> Maybe.withDefault []))
<| joinedRoomsTimelineEvents s |> Maybe.withDefault Dict.empty
|> Dict.toList
|> List.concatMap (\(k, vs) -> List.map (\v -> (k, v)) vs)

View File

@@ -2,7 +2,7 @@ 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.UserData exposing (getSenderName)
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)
@@ -86,7 +86,10 @@ changeRoomData jr rd =
, messages = changeTimeline jr rd.messages , messages = changeTimeline jr rd.messages
, ephemeral = changeEphemeral jr rd.ephemeral , ephemeral = changeEphemeral jr rd.ephemeral
, unreadNotifications = changeNotifications jr rd.unreadNotifications , unreadNotifications = changeNotifications jr rd.unreadNotifications
, prevHistoryBatch = Maybe.andThen .prevBatch jr.timeline , prevHistoryBatch =
case rd.prevHistoryBatch of
Nothing -> Maybe.andThen .prevBatch jr.timeline
Just _ -> rd.prevHistoryBatch
} }
updateRoomData : JoinedRoom -> Maybe RoomData -> Maybe RoomData updateRoomData : JoinedRoom -> Maybe RoomData -> Maybe RoomData
@@ -130,8 +133,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
@@ -139,11 +142,16 @@ 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
getRoomNotificationCount : RoomData -> (Int, Int) getLocalDisplayName : RoomData -> Username -> String
getRoomNotificationCount rd = getLocalDisplayName rd u =
getStateData ("m.room.member", u) (field "displayname" string) rd
|> Maybe.withDefault (getSenderName u)
getNotificationCount : RoomData -> (Int, Int)
getNotificationCount rd =
( Maybe.withDefault 0 rd.unreadNotifications.notificationCount ( Maybe.withDefault 0 rd.unreadNotifications.notificationCount
, Maybe.withDefault 0 rd.unreadNotifications.highlightCount , Maybe.withDefault 0 rd.unreadNotifications.highlightCount
) )
@@ -153,7 +161,7 @@ getTotalNotificationCount =
let let
sumTuples (x1, y1) (x2, y2) = (x1+x2, y1+y2) sumTuples (x1, y1) (x2, y2) = (x1+x2, y1+y2)
in in
Dict.foldl (\_ -> sumTuples << getRoomNotificationCount) (0, 0) Dict.foldl (\_ -> sumTuples << getNotificationCount) (0, 0)
getTotalNotificationCountString : OpenRooms -> Maybe String getTotalNotificationCountString : OpenRooms -> Maybe String
getTotalNotificationCountString or = getTotalNotificationCountString or =

View File

@@ -2,7 +2,8 @@ module Scylla.Sync.AccountData exposing (..)
import Scylla.ListUtils exposing (..) import Scylla.ListUtils exposing (..)
import Scylla.Sync.DecodeTools exposing (maybeDecode) import Scylla.Sync.DecodeTools exposing (maybeDecode)
import Scylla.Sync.Events exposing (Event, eventDecoder) import Scylla.Sync.Events exposing (Event, eventDecoder)
import Json.Decode as Decode exposing (Decoder, list, decodeValue) import Scylla.Sync.Push exposing (Ruleset, rulesetDecoder)
import Json.Decode as Decode exposing (Decoder, list, field, decodeValue)
import Dict exposing (Dict) import Dict exposing (Dict)
type alias AccountData = type alias AccountData =
@@ -48,3 +49,6 @@ getAccountData key d ad = ad.events
getDirectMessages : AccountData -> Maybe DirectMessages getDirectMessages : AccountData -> Maybe DirectMessages
getDirectMessages = getAccountData "m.direct" directMessagesDecoder getDirectMessages = getAccountData "m.direct" directMessagesDecoder
getPushRuleset : AccountData -> Maybe Ruleset
getPushRuleset = getAccountData "m.push_rules" (field "global" rulesetDecoder)

View File

@@ -38,8 +38,8 @@ type RoomEvent
roomEventDecoder : Decoder RoomEvent roomEventDecoder : Decoder RoomEvent
roomEventDecoder = oneOf roomEventDecoder = oneOf
[ Decode.map MessageRoomEvent messageEventDecoder [ Decode.map StateRoomEvent stateEventDecoder
, Decode.map StateRoomEvent stateEventDecoder , Decode.map MessageRoomEvent messageEventDecoder
] ]
type alias MessageEvent = type alias MessageEvent =
@@ -124,6 +124,12 @@ getType re =
StateRoomEvent e -> e.type_ StateRoomEvent e -> e.type_
MessageRoomEvent e -> e.type_ MessageRoomEvent e -> e.type_
getContent : RoomEvent -> Decode.Value
getContent re =
case re of
StateRoomEvent e -> e.content
MessageRoomEvent e -> e.content
toStateEvent : RoomEvent -> Maybe StateEvent toStateEvent : RoomEvent -> Maybe StateEvent
toStateEvent re = toStateEvent re =
case re of case re of

167
src/Scylla/Sync/Push.elm Normal file
View File

@@ -0,0 +1,167 @@
module Scylla.Sync.Push exposing (..)
import Scylla.Sync.DecodeTools exposing (maybeDecode)
import Scylla.Sync.Events exposing (RoomEvent, getSender, getContent, getType)
import Scylla.Route exposing (RoomId)
import Json.Decode as Decode exposing (Decoder, string, int, field, value, bool, list)
import Json.Decode.Pipeline exposing (required, optional)
type Condition
= EventMatch String String
| ContainsDisplayName
| RoomMemberCount Int
| SenderNotificationPermission String
conditionDecoder : Decoder Condition
conditionDecoder =
let
eventMatchDecoder =
Decode.succeed EventMatch
|> required "key" string
|> required "pattern" string
containsDisplayNameDecoder =
Decode.succeed ContainsDisplayName
roomMemberCountDecoder =
Decode.succeed RoomMemberCount
|> required "is"
(Decode.map (Maybe.withDefault 0 << String.toInt) string)
senderNotifPermissionDecoder =
Decode.succeed SenderNotificationPermission
|> required "key" string
dispatchDecoder k =
case k of
"event_match" -> eventMatchDecoder
"contains_display_name" -> containsDisplayNameDecoder
"room_member_count" -> roomMemberCountDecoder
"sender_notification_permission" -> senderNotifPermissionDecoder
_ -> Decode.fail "Unknown condition code"
in
field "kind" string
|> Decode.andThen dispatchDecoder
type Action
= Notify
| DontNotify
| Coalesce
| SetTweak String (Maybe Decode.Value)
actionDecoder : Decoder Action
actionDecoder =
let
dispatchStringDecoder s =
case s of
"notify" -> Decode.succeed Notify
"dont_notify" -> Decode.succeed DontNotify
"coalesce" -> Decode.succeed Coalesce
_ -> Decode.fail "Unknown action string"
objectDecoder =
Decode.succeed SetTweak
|> required "set_tweak" string
|> maybeDecode "value" value
in
Decode.oneOf
[ string |> Decode.andThen dispatchStringDecoder
, objectDecoder
]
type alias Rule =
{ ruleId : String
, default : Bool
, enabled : Bool
, conditions : List Condition
, actions : List Action
}
ruleDecoder : Decoder Rule
ruleDecoder =
let
patternDecoder = Decode.oneOf
[ field "pattern" string
|> Decode.andThen
(\p -> Decode.succeed <| \r ->
{ r | conditions = (EventMatch "content.body" p)::r.conditions })
, Decode.succeed identity
]
basicRuleDecoder = Decode.succeed Rule
|> required "rule_id" string
|> optional "default" bool True
|> optional "enabled" bool False
|> optional "conditions" (list conditionDecoder) []
|> required "actions" (list actionDecoder)
in
patternDecoder
|> Decode.andThen (\f -> Decode.map f basicRuleDecoder)
type alias Ruleset =
{ content : List Rule
, override : List Rule
, room : List Rule
, sender : List Rule
, underride : List Rule
}
rulesetDecoder : Decoder Ruleset
rulesetDecoder = Decode.succeed Ruleset
|> optional "content" (list ruleDecoder) []
|> optional "override" (list ruleDecoder) []
|> optional "room" (list ruleDecoder) []
|> optional "sender" (list ruleDecoder) []
|> optional "underride" (list ruleDecoder) []
checkCondition : RoomEvent -> Condition -> Bool
checkCondition re c =
let
pathDecoder xs p =
Decode.at xs string
|> Decode.map (String.contains p << String.toLower)
matchesPattern xs p =
case Decode.decodeValue (pathDecoder xs p) (getContent re) of
Ok True -> True
_ -> False
in
case c of
EventMatch k p ->
case String.split "." k of
"content"::xs -> matchesPattern xs p
"type"::[] -> String.contains p <| getType re
_ -> False
ContainsDisplayName -> False
RoomMemberCount _ -> False
SenderNotificationPermission _ -> False
applyAction : Action -> List Action -> List Action
applyAction a as_ =
case a of
Notify -> Notify :: List.filter (\a_ -> a_ /= DontNotify) as_
DontNotify -> DontNotify :: List.filter (\a_ -> a_ /= Notify) as_
Coalesce -> Coalesce :: List.filter (\a_ -> a_ /= DontNotify) as_
a_ -> a_ :: as_
applyActions : List Action -> List Action -> List Action
applyActions l r = List.foldl applyAction r l
updatePushRuleActions : Rule -> RoomEvent -> List Action -> List Action
updatePushRuleActions r re as_ =
if List.all (checkCondition re) r.conditions
then applyActions r.actions as_
else as_
updatePushActions : List Rule -> RoomEvent -> List Action -> List Action
updatePushActions rs re as_ =
List.filter .enabled rs
|> List.foldl (\r -> updatePushRuleActions r re) as_
getPushActions : Ruleset -> RoomId -> RoomEvent -> List Action
getPushActions rs rid re =
let
roomRules = List.filter (((==) rid) << .ruleId) rs.room
senderRules = List.filter (((==) <| getSender re) << .ruleId) rs.sender
in
updatePushActions rs.underride re []
|> updatePushActions senderRules re
|> updatePushActions roomRules re
|> updatePushActions rs.override re
getEventNotification : Ruleset -> RoomId -> RoomEvent -> Bool
getEventNotification rs rid re =
getPushActions rs rid re
|> List.member Notify

View File

@@ -15,11 +15,6 @@ userDataDecoder =
|> optional "displayname" (Decode.map Just string) Nothing |> optional "displayname" (Decode.map Just string) Nothing
|> optional "avatar_url" (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 : Username -> String
getSenderName s = getSenderName s =
let let

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,19 +181,19 @@ 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 = receivedMessagesRoom rd roomReceived = getReceivedMessages rd
roomSending = sendingMessagesRoom rid snd roomSending = getSendingMessages rid snd
renderedMessages = List.map (userMessagesView ud au) renderedMessages = List.map (userMessagesView rd au)
<| mergeMessages lu <| groupMessages lu
<| roomReceived ++ roomSending <| roomReceived ++ roomSending
in in
messagesWrapperView rid renderedMessages messagesWrapperView rid renderedMessages
@@ -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