Compare commits

...

35 Commits

Author SHA1 Message Date
38968c3247 Get Scylla building with nix using elm2nix
https://github.com/cachix/elm2nix

Signed-off-by: Danila Fedorin <danila.fedorin@gmail.com>
2025-12-27 19:02:13 +00:00
71845ae091 Fix sender names not being used 2019-10-09 12:52:59 -07:00
4505b4ba27 Stop making dozens of /profile calls to get usernames 2019-10-09 12:42:33 -07:00
4ef8471585 Implement part of a push-based notification system 2019-10-04 21:26:11 -07:00
c3c2036c69 Fix incorrectly decoding state events in timeline 2019-09-14 21:01:51 -07:00
c3ed5c4cd1 Ignore nextBatch from timeline 2019-09-12 20:32:59 -07:00
105f7e6012 Add missing changes from previous commit 2019-09-12 16:00:23 -07:00
c594d9858f Rename some functions to be more clear 2019-09-12 15:56:21 -07:00
71e0b3f64e Perform further cleanup to Sync 2019-09-11 01:11:08 -07:00
8627123143 Remove all the merging code from Sync 2019-09-11 01:07:39 -07:00
5c02ae8a58 Fully switch away from keeping sync 2019-09-11 00:52:42 -07:00
29e81a88ac Start switching from sync to room data 2019-09-10 23:24:47 -07:00
676d6c28a7 Add initial implementation of new room structure 2019-09-10 22:33:58 -07:00
595e28853e Split Sync file into sub-modules 2019-09-10 20:19:26 -07:00
ccfd2fe76b Fix botched unique implementation 2019-09-09 01:56:38 -07:00
911e46c4c3 Add support for m.notice and m.emote 2019-09-08 15:00:52 -07:00
266c421223 Fix flickering (thanks Matrix spec) 2019-09-08 14:22:08 -07:00
3b1dabd624 Remove homebrew notification system. Will be using the spec for this. 2019-09-07 18:28:58 -07:00
1d50c5b1e4 Start working towards setting notification settings 2019-09-07 18:03:38 -07:00
360b7be281 Change room name func to match user name func 2019-09-07 17:06:23 -07:00
06799194e4 Move account data code into account data module 2019-09-07 16:55:56 -07:00
8623eb8dfd Refactor new user command 2019-09-07 16:38:09 -07:00
db2def5388 Update screenshot 2019-09-07 00:11:13 -07:00
5e3aa40a35 Use Elm's lazy to optimize for many-message performance 2019-09-06 23:55:36 -07:00
7122d9e567 Put uniqueBy back in sync 2019-09-02 01:50:53 -07:00
207f6ab3be Remove dependency on model in message list 2019-09-02 01:10:28 -07:00
f395259137 Improve performance by computing room names at sync, rather than on view. 2019-09-02 00:46:59 -07:00
5d5418e9c6 Use m.direct for direct message names. 2019-09-01 00:37:30 -07:00
b23c80f463 Switch to a tail recursive version of uniqueBy 2019-08-31 23:00:52 -07:00
f6ce669fb4 Fix font size property 2019-08-23 21:22:38 -07:00
392d799bcf Fix missing padding in reconnect message 2019-08-21 23:29:47 -07:00
115cbd9a76 Tone the font size down 2019-08-21 21:46:00 -07:00
bc794955e3 Prototype switching to em. 2019-08-21 21:40:58 -07:00
b8fc33eae6 Make minor visual changes 2019-08-21 21:20:30 -07:00
7d09b4ad9a Make notifications more consistent. 2019-08-21 18:40:45 -07:00
27 changed files with 1300 additions and 837 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.

Binary file not shown.

Before

Width:  |  Height:  |  Size: 199 KiB

After

Width:  |  Height:  |  Size: 518 KiB

View File

@@ -1,8 +1,13 @@
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)
import Scylla.Room exposing (OpenRooms, applySync)
import Scylla.Sync exposing (..) import Scylla.Sync exposing (..)
import Scylla.Room exposing (..) import Scylla.Sync.Events exposing (toMessageEvent, getType, getSender, getUnsigned)
import Scylla.Sync.AccountData exposing (..)
import Scylla.Sync.Push exposing (..)
import Scylla.ListUtils exposing (..)
import Scylla.Messages exposing (..) import Scylla.Messages exposing (..)
import Scylla.Login exposing (..) import Scylla.Login exposing (..)
import Scylla.Api exposing (..) import Scylla.Api exposing (..)
@@ -10,11 +15,10 @@ 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 (..)
import Scylla.AccountData exposing (..) import Scylla.Room exposing (..)
import Url exposing (Url) import Url exposing (Url)
import Url.Parser exposing (parse) import Url.Parser exposing (parse)
import Url.Builder import Url.Builder
@@ -41,19 +45,15 @@ init _ url key =
, loginUsername = "" , loginUsername = ""
, loginPassword = "" , loginPassword = ""
, apiUrl = "https://matrix.org" , apiUrl = "https://matrix.org"
, sync = , nextBatch = ""
{ nextBatch = "" , accountData = { events = Just [] }
, rooms = Nothing
, presence = Nothing
, accountData = Nothing
}
, errors = [] , errors = []
, 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
} }
cmd = getStoreValuePort "scylla.loginInfo" cmd = getStoreValuePort "scylla.loginInfo"
in in
@@ -62,7 +62,7 @@ init _ url key =
view : Model -> Browser.Document Msg view : Model -> Browser.Document Msg
view m = view m =
let let
notificationString = totalNotificationCountString m.sync notificationString = getTotalNotificationCountString m.rooms
titleString = case notificationString of titleString = case notificationString of
Nothing -> "Scylla" Nothing -> "Scylla"
Just s -> s ++ " Scylla" Just s -> s ++ " Scylla"
@@ -85,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
@@ -172,26 +172,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
newUsersCmd h = Cmd.batch
<| List.map (userData m.apiUrl (Maybe.withDefault "" m.token))
<| newUsers m
<| uniqueBy (\s -> s)
<| List.map .sender
<| h.chunk
in
case hr of case hr of
Ok h -> ({ m | sync = appendHistoryResponse m.sync r h }, newUsersCmd h) Ok h -> ({ m | rooms = applyHistoryResponse r h m.rooms }, Cmd.none)
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)
updateHistory m r = updateHistory m r =
let let
prevBatch = Maybe.andThen .prevBatch prevBatch = Dict.get r m.rooms
<| Maybe.andThen .timeline |> Maybe.andThen (.prevHistoryBatch)
<| Maybe.andThen (Dict.get r)
<| Maybe.andThen .join
<| m.sync.rooms
command = case prevBatch of command = case prevBatch of
Just pv -> getHistory m.apiUrl (Maybe.withDefault "" m.token) r pv Just pv -> getHistory m.apiUrl (Maybe.withDefault "" m.token) r pv
Nothing -> Cmd.none Nothing -> Cmd.none
@@ -246,9 +235,10 @@ updateChangeRoute : Model -> Route -> (Model, Cmd Msg)
updateChangeRoute m r = updateChangeRoute m r =
let let
joinedRoom = case r of 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 _ -> Nothing
lastMessage = Maybe.andThen (findLastEvent (((==) "m.room.message") << .type_)) <| Maybe.andThen .events <| Maybe.andThen .timeline joinedRoom lastMessage = Maybe.map .messages joinedRoom
|> Maybe.andThen (findLastEvent (((==) "m.room.message") << .type_))
readMarkerCmd = case (r, lastMessage) of readMarkerCmd = case (r, lastMessage) of
(Room rid, Just re) -> setReadMarkers m.apiUrl (Maybe.withDefault "" m.token) rid re.eventId <| Just re.eventId (Room rid, Just re) -> setReadMarkers m.apiUrl (Maybe.withDefault "" m.token) rid re.eventId <| Just re.eventId
_ -> Cmd.none _ -> Cmd.none
@@ -264,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
@@ -304,23 +289,21 @@ updateSyncResponse : Model -> Result Http.Error SyncResponse -> Bool -> (Model,
updateSyncResponse model r notify = updateSyncResponse model r notify =
let let
token = Maybe.withDefault "" model.token token = Maybe.withDefault "" model.token
nextBatch = Result.withDefault model.sync.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
newUserCmd sr = Cmd.batch notification sr =
<| List.map (userData model.apiUrl getPushRuleset model.accountData
<| Maybe.withDefault "" model.token) |> Maybe.map (\rs -> getNotificationEvents rs sr)
<| newUsers model |> Maybe.withDefault []
<| allUsers sr |> findFirstBy
notification sr = findFirstBy
(\(s, e) -> e.originServerTs) (\(s, e) -> e.originServerTs)
(\(s, e) -> e.sender /= model.loginUsername) (\(s, e) -> e.sender /= model.loginUsername)
<| joinedRoomNotificationEvents sr
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 = displayName model 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
@@ -328,6 +311,7 @@ updateSyncResponse model r notify =
roomMessages sr = case room of roomMessages sr = case room of
Just rid -> List.filter (((==) "m.room.message") << .type_) Just rid -> List.filter (((==) "m.room.message") << .type_)
<| Maybe.withDefault [] <| Maybe.withDefault []
<| Maybe.map (List.filterMap (toMessageEvent))
<| Maybe.andThen .events <| Maybe.andThen .events
<| Maybe.andThen .timeline <| Maybe.andThen .timeline
<| Maybe.andThen (Dict.get rid) <| Maybe.andThen (Dict.get rid)
@@ -342,12 +326,20 @@ updateSyncResponse model r notify =
(Just rid, Just re) -> setReadMarkers model.apiUrl token rid re.eventId <| Just re.eventId (Just rid, Just re) -> setReadMarkers model.apiUrl token rid re.eventId <| Just re.eventId
_ -> Cmd.none _ -> Cmd.none
receivedEvents sr = List.map Just <| allTimelineEventIds sr receivedEvents sr = List.map Just <| allTimelineEventIds sr
sending sr = Dict.filter (\_ (rid, { body, id }) -> not <| List.member id <| receivedEvents sr) model.sending 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
newModel sr =
{ model | nextBatch = nextBatch
, sending = sending sr
, rooms = applySync sr model.rooms
, accountData = applyAccountData sr.accountData model.accountData
}
in in
case r of case r of
Ok sr -> ({ model | sync = mergeSyncResponse model.sync sr, sending = sending (mergeSyncResponse model.sync sr) }, Cmd.batch Ok sr -> (newModel sr
, Cmd.batch
[ syncCmd [ syncCmd
, newUserCmd sr
, notificationCmd sr , notificationCmd sr
, setScrollCmd sr , setScrollCmd sr
, setReadReceiptCmd sr , setReadReceiptCmd sr

View File

@@ -1,30 +0,0 @@
module Scylla.AccountData exposing (..)
import Scylla.Sync exposing (SyncResponse, AccountData, JoinedRoom, roomAccountData)
import Json.Decode as Decode
import Dict
type NotificationSetting = Normal | MentionsOnly | None
notificationSettingDecoder : Decode.Decoder NotificationSetting
notificationSettingDecoder =
let
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
roomNotificationSetting : JoinedRoom -> NotificationSetting
roomNotificationSetting jr = Maybe.withDefault Normal
<| Maybe.andThen Result.toMaybe
<| Maybe.map (Decode.decodeValue notificationSettingDecoder)
<| roomAccountData jr "com.danilafe.scylla.notifications"
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

@@ -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
@@ -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
}

39
src/Scylla/ListUtils.elm Normal file
View File

@@ -0,0 +1,39 @@
module Scylla.ListUtils exposing (..)
import Dict exposing (Dict)
import Set exposing (Set)
groupBy : (a -> comparable) -> List a -> Dict comparable (List a)
groupBy f xs =
let
update v ml = case ml of
Just l -> Just (v::l)
Nothing -> Just [ v ]
in
List.foldl (\v acc -> Dict.update (f v) (update v) acc) Dict.empty xs
uniqueByTailRecursive : (a -> comparable) -> List a -> Set comparable -> List a -> List a
uniqueByTailRecursive f l s acc =
case l of
x::tail ->
if Set.member (f x) s
then uniqueByTailRecursive f tail s acc
else uniqueByTailRecursive f tail (Set.insert (f x) s) (x::acc)
[] -> List.reverse acc
uniqueBy : (a -> comparable) -> List a -> List a
uniqueBy f l = uniqueByTailRecursive f l Set.empty []
findFirst : (a -> Bool) -> List a -> Maybe a
findFirst cond l = case l of
x::xs -> if cond x then Just x else findFirst cond xs
[] -> Nothing
findLast : (a -> Bool) -> List a -> Maybe a
findLast cond l = findFirst cond <| List.reverse l
findFirstBy : (a -> comparable) -> (a -> Bool) -> List a -> Maybe a
findFirstBy sortFunction cond l = findFirst cond <| List.sortBy sortFunction l
findLastBy : (a -> comparable) -> (a -> Bool) -> List a -> Maybe a
findLastBy sortFunction cond l = findLast cond <| List.sortBy sortFunction l

View File

@@ -1,6 +1,9 @@
module Scylla.Messages exposing (..) module Scylla.Messages exposing (..)
import Scylla.Sync exposing (RoomEvent) import Scylla.Sync.Events exposing (RoomEvent, MessageEvent, toMessageEvent)
import Scylla.Login exposing (Username) import Scylla.Login exposing (Username)
import Scylla.Route exposing (RoomId)
import Scylla.Room exposing (RoomData)
import Dict exposing (Dict)
type SendingMessageBody = TextMessage String type SendingMessageBody = TextMessage String
@@ -9,17 +12,17 @@ type alias SendingMessage =
, id : Maybe String , id : Maybe String
} }
type Message = type Message
Sending SendingMessage = Sending SendingMessage
| Received RoomEvent | 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
@@ -27,9 +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
getReceivedMessages : RoomData -> List Message
getReceivedMessages rd = rd.messages
|> List.filter (\e -> e.type_ == "m.room.message")
|> List.map Received
getSendingMessages : RoomId -> Dict Int (RoomId, SendingMessage) -> List Message
getSendingMessages rid ms = List.map (\(tid, (_, sm)) -> Sending sm)
<| List.filter (\(_, (nrid, _)) -> nrid == rid)
<| Dict.toList ms

View File

@@ -1,8 +1,14 @@
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) import Scylla.Room exposing (getLocalDisplayName)
import Scylla.Sync exposing (SyncResponse, HistoryResponse)
import Scylla.ListUtils exposing (findFirst)
import Scylla.Room exposing (OpenRooms)
import Scylla.UserData exposing (UserData, getSenderName)
import Scylla.Sync.Rooms exposing (JoinedRoom)
import Scylla.Sync.Push exposing (Ruleset)
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 (..)
@@ -13,7 +19,7 @@ import Url.Builder
import Dict exposing (Dict) import Dict exposing (Dict)
import Time exposing (Posix) import Time exposing (Posix)
import File exposing (File) import File exposing (File)
import Json.Decode import Json.Decode as Decode
import Browser import Browser
import Http import Http
import Url exposing (Url) import Url exposing (Url)
@@ -25,14 +31,15 @@ type alias Model =
, loginUsername : Username , loginUsername : Username
, loginPassword : Password , loginPassword : Password
, apiUrl : ApiUrl , apiUrl : ApiUrl
, sync : SyncResponse , accountData : AccountData
, nextBatch : String
, errors : List String , errors : List String
, 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
} }
type Msg = type Msg =
@@ -54,44 +61,22 @@ type Msg =
| ReceiveUserData Username (Result Http.Error UserData) -- HTTP, receive user data | ReceiveUserData Username (Result Http.Error UserData) -- HTTP, receive user data
| ReceiveCompletedReadMarker (Result Http.Error ()) -- HTTP, read marker request completed | ReceiveCompletedReadMarker (Result Http.Error ()) -- HTTP, read marker request completed
| ReceiveCompletedTypingIndicator (Result Http.Error ()) -- HTTP, typing indicator request completed | ReceiveCompletedTypingIndicator (Result Http.Error ()) -- HTTP, typing indicator request completed
| ReceiveStoreData Json.Decode.Value -- We are send back a value on request from localStorage. | ReceiveStoreData Decode.Value -- We are send back a value on request from localStorage.
| 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 : Model -> Username -> String
displayName m s = Maybe.withDefault (senderName s) <| Maybe.andThen .displayName <| Dict.get s m.userData
roomDisplayName : Model -> JoinedRoom -> String
roomDisplayName m jr =
let
customName = roomName jr
roomUsers = List.filter ((/=) m.loginUsername) <| roomJoinedUsers jr
singleUserName = if List.length roomUsers == 1 then List.head roomUsers else Nothing
singleUserDisplayName = Maybe.andThen
(\u -> Maybe.andThen .displayName <| Dict.get u m.userData) singleUserName
firstOption d os = case os of
[] -> d
((Just v)::_) -> v
(Nothing::xs) -> firstOption d xs
in
firstOption "<No Name>"
[ customName
, singleUserDisplayName
, singleUserName
]
roomUrl : String -> String roomUrl : String -> String
roomUrl s = Url.Builder.absolute [ "room", s ] [] roomUrl s = Url.Builder.absolute [ "room", s ] []
@@ -99,17 +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
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 : 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, RoomEvent, joinedRoomsTimelineEvents) import Scylla.Sync exposing (SyncResponse, joinedRoomsTimelineEvents)
import Scylla.AccountData exposing (..) 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,24 +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
producesNotification : NotificationSetting -> RoomEvent -> Bool getText : MessageEvent -> String
producesNotification ns re = case ns of getText re = case (Decode.decodeValue (field "msgtype" string) re.content) of
Normal -> True
_ -> False
notificationText : RoomEvent -> String
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)
_ -> "" _ -> ""
joinedRoomNotificationEvents : SyncResponse -> List (String, RoomEvent) 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)
<| Dict.foldl (\k v a -> a ++ applyPair k v) [] |> Maybe.map (List.filterMap <| toMessageEvent)
<| Dict.map (\k v -> List.filter (producesNotification (roomIdNotificationSetting s k)) v) |> Maybe.withDefault []))
<| joinedRoomsTimelineEvents s |> Maybe.withDefault Dict.empty
|> Dict.toList
|> List.concatMap (\(k, vs) -> List.map (\v -> (k, v)) vs)

View File

@@ -1,37 +1,187 @@
module Scylla.Room exposing (..) module Scylla.Room exposing (..)
import Scylla.Model exposing (..) import Scylla.Route exposing (RoomId)
import Scylla.Sync exposing (..) import Scylla.Sync exposing (SyncResponse)
import Scylla.Messages exposing (..) import Scylla.Login exposing (Username)
import Scylla.Route exposing (..) import Scylla.UserData exposing (getSenderName)
import Dict import Scylla.Sync exposing (HistoryResponse)
import Scylla.Sync.Events exposing (MessageEvent, StateEvent, toStateEvent, toMessageEvent)
import Scylla.Sync.AccountData exposing (AccountData, getDirectMessages, applyAccountData)
import Scylla.Sync.Rooms exposing (JoinedRoom, UnreadNotificationCounts, Ephemeral)
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
type alias RoomData = type alias RoomData =
{ joinedRoom : JoinedRoom { roomState : RoomState
, sendingMessages : List (SendingMessage, Int) , messages : List (MessageEvent)
, inputText : Maybe String , accountData : AccountData
, ephemeral : Ephemeral
, unreadNotifications : UnreadNotificationCounts
, prevHistoryBatch : Maybe String
, text : String
} }
roomData : Model -> RoomId -> Maybe RoomData type alias OpenRooms = Dict RoomId RoomData
roomData m rid =
case Dict.get rid (joinedRooms m) of emptyOpenRooms : OpenRooms
Just jr -> Just emptyOpenRooms = Dict.empty
{ joinedRoom = jr
, sendingMessages = List.map (\(tid, (_, sm)) -> (sm, tid)) <| List.filter (\(_, (nrid, _)) -> nrid == rid) <| Dict.toList m.sending emptyRoomData : RoomData
, inputText = Dict.get rid m.roomText emptyRoomData =
{ roomState = Dict.empty
, messages = []
, accountData = { events = Just [] }
, ephemeral = { events = Just [] }
, unreadNotifications =
{ highlightCount = Just 0
, notificationCount = Just 0
}
, prevHistoryBatch = Nothing
, text = ""
} }
Nothing -> Nothing
currentRoomData : Model -> Maybe RoomData changeRoomStateEvent : StateEvent -> RoomState -> RoomState
currentRoomData m = Maybe.andThen (roomData m) <| currentRoomId m changeRoomStateEvent se = Dict.insert (se.type_, se.stateKey) se.content
extractMessageEvents : List RoomEvent -> List Message changeRoomStateEvents : List StateEvent -> RoomState -> RoomState
extractMessageEvents es = List.map Received changeRoomStateEvents es rs = List.foldr (changeRoomStateEvent) rs es
<| List.filter (\e -> e.type_ == "m.room.message") es
extractMessages : RoomData -> List Message changeRoomState : JoinedRoom -> RoomState -> RoomState
extractMessages rd = changeRoomState jr rs =
let let
eventMessages = extractMessageEvents <| Maybe.withDefault [] <| Maybe.andThen .events rd.joinedRoom.timeline stateDiff = jr.state
sendingMessages = List.map (\(sm, i) -> Sending sm) rd.sendingMessages |> Maybe.andThen .events
|> Maybe.withDefault []
timelineDiff = jr.timeline
|> Maybe.andThen .events
|> Maybe.map (List.filterMap toStateEvent)
|> Maybe.withDefault []
in in
eventMessages ++ sendingMessages rs
|> changeRoomStateEvents stateDiff
|> changeRoomStateEvents timelineDiff
changeTimeline : JoinedRoom -> List (MessageEvent) -> List (MessageEvent)
changeTimeline jr tl =
let
newMessages = jr.timeline
|> Maybe.andThen .events
|> Maybe.map (List.filterMap toMessageEvent)
|> Maybe.withDefault []
in
tl ++ newMessages
changeEphemeral : JoinedRoom -> Ephemeral -> Ephemeral
changeEphemeral jr e = Maybe.withDefault e jr.ephemeral
changeNotifications : JoinedRoom -> UnreadNotificationCounts -> UnreadNotificationCounts
changeNotifications jr un = Maybe.withDefault un jr.unreadNotifications
changeRoomData : JoinedRoom -> RoomData -> RoomData
changeRoomData jr rd =
{ 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 =
case rd.prevHistoryBatch of
Nothing -> Maybe.andThen .prevBatch jr.timeline
Just _ -> rd.prevHistoryBatch
}
updateRoomData : JoinedRoom -> Maybe RoomData -> Maybe RoomData
updateRoomData jr mrd = Maybe.withDefault emptyRoomData mrd
|> changeRoomData jr
|> Just
applyJoinedRoom : RoomId -> JoinedRoom -> OpenRooms -> OpenRooms
applyJoinedRoom rid jr = Dict.update rid (updateRoomData jr)
applySync : SyncResponse -> OpenRooms -> OpenRooms
applySync sr or =
let
joinedRooms = sr.rooms
|> Maybe.andThen .join
|> Maybe.withDefault Dict.empty
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)
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 -> RoomId -> RoomData -> String
getRoomName ad rid rd =
let
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) -> getLocalDisplayName rd d
_ -> rid
getLocalDisplayName : RoomData -> Username -> String
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.highlightCount
)
getTotalNotificationCount : OpenRooms -> (Int, Int)
getTotalNotificationCount =
let
sumTuples (x1, y1) (x2, y2) = (x1+x2, y1+y2)
in
Dict.foldl (\_ -> sumTuples << getNotificationCount) (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 ++ ")"
getHomeserver : String -> String
getHomeserver s =
let
colonIndex = Maybe.withDefault 0
<| Maybe.map ((+) 1)
<| List.head
<| String.indexes ":" s
in
String.dropLeft colonIndex s

View File

@@ -2,223 +2,16 @@ module Scylla.Sync exposing (..)
import Scylla.Api exposing (..) import Scylla.Api exposing (..)
import Scylla.Login exposing (Username) import Scylla.Login exposing (Username)
import Scylla.Route exposing (RoomId) import Scylla.Route exposing (RoomId)
import Scylla.ListUtils exposing (..)
import Scylla.Sync.DecodeTools exposing (maybeDecode)
import Scylla.Sync.Events exposing (..)
import Scylla.Sync.Rooms exposing (..)
import Scylla.Sync.AccountData exposing (..)
import Dict exposing (Dict) import Dict exposing (Dict)
import Json.Decode as Decode exposing (Decoder, int, string, float, list, value, dict, bool, field) import Json.Decode as Decode exposing (Decoder, int, string, float, list, value, dict, bool, field)
import Json.Decode.Pipeline exposing (required, optional) import Json.Decode.Pipeline exposing (required, optional)
import Set exposing (Set) import Set exposing (Set)
-- Special Decoding
decodeJust : Decoder a -> Decoder (Maybe a)
decodeJust = Decode.map Just
maybeDecode : String -> Decoder a -> Decoder (Maybe a -> b) -> Decoder b
maybeDecode s d = optional s (decodeJust d) Nothing
-- General Events
type alias Event =
{ content : Decode.Value
, type_ : String
}
eventDecoder : Decoder Event
eventDecoder =
Decode.succeed Event
|> required "content" value
|> required "type" string
type alias EventContent = Decode.Value
eventContentDecoder : Decoder EventContent
eventContentDecoder = Decode.value
-- Unsigned Data
type alias UnsignedData =
{ age : Maybe Int
, redactedBecause : Maybe Event
, transactionId : Maybe String
}
unsignedDataDecoder : Decoder UnsignedData
unsignedDataDecoder =
Decode.succeed UnsignedData
|> maybeDecode "age" int
|> maybeDecode "redacted_because" eventDecoder
|> maybeDecode "transaction_id" string
-- State
type alias State =
{ events : Maybe (List StateEvent)
}
stateDecoder : Decoder State
stateDecoder =
Decode.succeed State
|> maybeDecode "events" (list stateEventDecoder)
type alias StateEvent =
{ content : Decode.Value
, type_ : String
, eventId : String
, sender : String
, originServerTs : Int
, unsigned : Maybe UnsignedData
, prevContent : Maybe EventContent
, stateKey : String
}
stateEventDecoder : Decoder StateEvent
stateEventDecoder =
Decode.succeed StateEvent
|> required "content" value
|> required "type" string
|> required "event_id" string
|> required "sender" string
|> required "origin_server_ts" int
|> maybeDecode "unsigned" unsignedDataDecoder
|> maybeDecode "prev_content" eventContentDecoder
|> required "state_key" string
-- Rooms
type alias Rooms =
{ join : Maybe (Dict String JoinedRoom)
, invite : Maybe (Dict String InvitedRoom)
, leave : Maybe (Dict String LeftRoom)
}
roomsDecoder : Decoder Rooms
roomsDecoder =
Decode.succeed Rooms
|> maybeDecode "join" (dict joinedRoomDecoder)
|> maybeDecode "invite" (dict invitedRoomDecoder)
|> maybeDecode "leave" (dict leftRoomDecoder)
type alias JoinedRoom =
{ state : Maybe State
, timeline : Maybe Timeline
, ephemeral : Maybe Ephemeral
, accountData : Maybe AccountData
, unreadNotifications : Maybe UnreadNotificationCounts
}
joinedRoomDecoder : Decoder JoinedRoom
joinedRoomDecoder =
Decode.succeed JoinedRoom
|> maybeDecode "state" stateDecoder
|> maybeDecode "timeline" timelineDecoder
|> maybeDecode "ephemeral" ephemeralDecoder
|> maybeDecode "account_data" accountDataDecoder
|> maybeDecode "unread_notifications" unreadNotificationCountsDecoder
-- Joined Room Data
type alias Timeline =
{ events : Maybe (List RoomEvent)
, limited : Maybe Bool
, prevBatch : Maybe String
}
timelineDecoder =
Decode.succeed Timeline
|> maybeDecode "events" (list roomEventDecoder)
|> maybeDecode "limited" bool
|> maybeDecode "prev_batch" string
type alias RoomEvent =
{ content : Decode.Value
, type_ : String
, eventId : String
, sender : String
, originServerTs : Int
, unsigned : Maybe UnsignedData
}
roomEventDecoder : Decoder RoomEvent
roomEventDecoder =
Decode.succeed RoomEvent
|> required "content" value
|> required "type" string
|> required "event_id" string
|> required "sender" string
|> required "origin_server_ts" int
|> maybeDecode "unsigned" unsignedDataDecoder
type alias Ephemeral =
{ events : Maybe (List Event)
}
ephemeralDecoder : Decoder Ephemeral
ephemeralDecoder =
Decode.succeed Ephemeral
|> maybeDecode "events" (list eventDecoder)
type alias AccountData =
{ events : Maybe (List Event)
}
accountDataDecoder : Decoder AccountData
accountDataDecoder =
Decode.succeed AccountData
|> maybeDecode "events" (list eventDecoder)
type alias UnreadNotificationCounts =
{ highlightCount : Maybe Int
, notificationCount : Maybe Int
}
unreadNotificationCountsDecoder : Decoder UnreadNotificationCounts
unreadNotificationCountsDecoder =
Decode.succeed UnreadNotificationCounts
|> maybeDecode "highlight_count" int
|> maybeDecode "notification_count" int
-- Invited Room Data
type alias InvitedRoom =
{ inviteState : Maybe InviteState
}
invitedRoomDecoder : Decoder InvitedRoom
invitedRoomDecoder =
Decode.succeed InvitedRoom
|> maybeDecode "invite_state" inviteStateDecoder
type alias InviteState =
{ events : Maybe (List StrippedState)
}
inviteStateDecoder : Decoder InviteState
inviteStateDecoder =
Decode.succeed InviteState
|> maybeDecode "events" (list strippedStateDecoder)
type alias StrippedState =
{ content : EventContent
, stateKey : String
, type_ : String
, sender : String
}
strippedStateDecoder : Decoder StrippedState
strippedStateDecoder =
Decode.succeed StrippedState
|> required "content" eventContentDecoder
|> required "state_key" string
|> required "type" string
|> required "sender" string
-- Left Room Data
type alias LeftRoom =
{ state : Maybe State
, timeline : Maybe Timeline
, accountData : Maybe AccountData
}
leftRoomDecoder : Decoder LeftRoom
leftRoomDecoder =
Decode.succeed LeftRoom
|> maybeDecode "state" stateDecoder
|> maybeDecode "timeline" timelineDecoder
|> maybeDecode "account_data" accountDataDecoder
-- General Sync Response -- General Sync Response
type alias SyncResponse = type alias SyncResponse =
{ nextBatch : String { nextBatch : String
@@ -259,211 +52,20 @@ historyResponseDecoder =
|> required "chunk" (list roomEventDecoder) |> required "chunk" (list roomEventDecoder)
-- Business Logic: Helper Functions -- Business Logic: Helper Functions
groupBy : (a -> comparable) -> List a -> Dict comparable (List a)
groupBy f xs =
let
update v ml = case ml of
Just l -> Just (v::l)
Nothing -> Just [ v ]
in
List.foldl (\v acc -> Dict.update (f v) (update v) acc) Dict.empty xs
uniqueByRecursive : (a -> comparable) -> List a -> Set comparable -> List a
uniqueByRecursive f l s = case l of
x::tail -> if Set.member (f x) s
then uniqueByRecursive f tail s
else x::uniqueByRecursive f tail (Set.insert (f x) s)
[] -> []
uniqueBy : (a -> comparable) -> List a -> List a
uniqueBy f l = uniqueByRecursive f l Set.empty
findFirst : (a -> Bool) -> List a -> Maybe a
findFirst cond l = case l of
x::xs -> if cond x then Just x else findFirst cond xs
[] -> Nothing
findLast : (a -> Bool) -> List a -> Maybe a
findLast cond l = findFirst cond <| List.reverse l
findFirstBy : (a -> comparable) -> (a -> Bool) -> List a -> Maybe a
findFirstBy sortFunction cond l = findFirst cond <| List.sortBy sortFunction l
findLastBy : (a -> comparable) -> (a -> Bool) -> List a -> Maybe a
findLastBy sortFunction cond l = findLast cond <| List.sortBy sortFunction l
findFirstEvent : ({ a | originServerTs : Int } -> Bool) -> List { a | originServerTs : Int } -> Maybe { a | originServerTs : Int } findFirstEvent : ({ a | originServerTs : Int } -> Bool) -> List { a | originServerTs : Int } -> Maybe { a | originServerTs : Int }
findFirstEvent = findFirstBy .originServerTs findFirstEvent = findFirstBy .originServerTs
findLastEvent : ({ a | originServerTs : Int } -> Bool) -> List { a | originServerTs : Int } -> Maybe { a | originServerTs : Int } findLastEvent : ({ a | originServerTs : Int } -> Bool) -> List { a | originServerTs : Int } -> Maybe { a | originServerTs : Int }
findLastEvent = findLastBy .originServerTs findLastEvent = findLastBy .originServerTs
-- Business Logic: Merging
mergeMaybe : (a -> a -> a) -> Maybe a -> Maybe a -> Maybe a
mergeMaybe f l r = case (l, r) of
(Just v1, Just v2) -> Just <| f v1 v2
(Just v, Nothing) -> Just v
(Nothing, Just v) -> Just v
_ -> Nothing
mergeEvents : List Event -> List Event -> List Event
mergeEvents l1 l2 = l1 ++ l2
mergeStateEvents : List StateEvent -> List StateEvent -> List StateEvent
mergeStateEvents l1 l2 = uniqueBy .eventId <| l1 ++ l2
mergeRoomEvents : List RoomEvent -> List RoomEvent -> List RoomEvent
mergeRoomEvents l1 l2 = uniqueBy .eventId <| l1 ++ l2
mergeStrippedStates : List StrippedState -> List StrippedState -> List StrippedState
mergeStrippedStates l1 l2 = l1 ++ l2
mergeAccountData : AccountData -> AccountData -> AccountData
mergeAccountData a1 a2 = AccountData <| mergeMaybe mergeEvents a1.events a2.events
mergePresence : Presence -> Presence -> Presence
mergePresence p1 p2 = Presence <| mergeMaybe mergeEvents p1.events p2.events
mergeDicts : (b -> b -> b) -> Dict comparable b -> Dict comparable b -> Dict comparable b
mergeDicts f d1 d2 =
let
inOne = Dict.insert
inBoth k v1 v2 = Dict.insert k (f v1 v2)
in
Dict.merge inOne inBoth inOne d1 d2 (Dict.empty)
mergeState : State -> State -> State
mergeState s1 s2 = State <| mergeMaybe mergeStateEvents s1.events s2.events
mergeTimeline : Timeline -> Timeline -> Timeline
mergeTimeline t1 t2 = Timeline (mergeMaybe mergeRoomEvents t1.events t2.events) Nothing t1.prevBatch
mergeEphemeral : Ephemeral -> Ephemeral -> Ephemeral
mergeEphemeral e1 e2 = Ephemeral <| mergeMaybe mergeEvents e1.events e2.events
mergeJoinedRoom : JoinedRoom -> JoinedRoom -> JoinedRoom
mergeJoinedRoom r1 r2 =
{ r2 | state = mergeMaybe mergeState r1.state r2.state
, timeline = mergeMaybe mergeTimeline r1.timeline r2.timeline
, accountData = mergeMaybe mergeAccountData r1.accountData r2.accountData
, ephemeral = mergeMaybe mergeEphemeral r1.ephemeral r2.ephemeral
}
mergeInviteState : InviteState -> InviteState -> InviteState
mergeInviteState i1 i2 = InviteState <| mergeMaybe mergeStrippedStates i1.events i2.events
mergeInvitedRoom : InvitedRoom -> InvitedRoom -> InvitedRoom
mergeInvitedRoom i1 i2 = InvitedRoom <| mergeMaybe mergeInviteState i1.inviteState i2.inviteState
mergeLeftRoom : LeftRoom -> LeftRoom -> LeftRoom
mergeLeftRoom l1 l2 = LeftRoom
(mergeMaybe mergeState l1.state l2.state)
(mergeMaybe mergeTimeline l1.timeline l2.timeline)
(mergeMaybe mergeAccountData l1.accountData l2.accountData)
mergeJoin : Dict String JoinedRoom -> Dict String JoinedRoom -> Dict String JoinedRoom
mergeJoin = mergeDicts mergeJoinedRoom
mergeInvite : Dict String InvitedRoom -> Dict String InvitedRoom -> Dict String InvitedRoom
mergeInvite = mergeDicts mergeInvitedRoom
mergeLeave : Dict String LeftRoom -> Dict String LeftRoom -> Dict String LeftRoom
mergeLeave = mergeDicts mergeLeftRoom
mergeRooms : Rooms -> Rooms -> Rooms
mergeRooms r1 r2 =
{ join = mergeMaybe mergeJoin r1.join r2.join
, invite = mergeMaybe mergeInvite r1.invite r2.invite
, leave = mergeMaybe mergeLeave r1.leave r2.leave
}
mergeSyncResponse : SyncResponse -> SyncResponse -> SyncResponse
mergeSyncResponse l r =
{ r | rooms = mergeMaybe mergeRooms l.rooms r.rooms
, accountData = mergeMaybe mergeAccountData l.accountData r.accountData
}
appendRoomHistoryResponse : JoinedRoom -> HistoryResponse -> JoinedRoom
appendRoomHistoryResponse jr hr =
let
oldEvents = Maybe.withDefault [] <| Maybe.andThen .events jr.timeline
newEvents = mergeRoomEvents (List.reverse hr.chunk) oldEvents
newTimeline = case jr.timeline of
Just t -> Just { t | events = Just newEvents, prevBatch = Just hr.end }
Nothing -> Just { events = Just newEvents, prevBatch = Just hr.end, limited = Nothing }
in
{ jr | timeline = newTimeline }
appendHistoryResponse : SyncResponse -> RoomId -> HistoryResponse -> SyncResponse
appendHistoryResponse sr r hr =
let
appendMaybeRoomHistoryResponse mr = Just <| case mr of
Just jr -> appendRoomHistoryResponse jr hr
Nothing ->
{ state = Nothing
, timeline = Just
{ events = Just hr.chunk
, limited = Nothing
, prevBatch = Just hr.end
}
, ephemeral = Nothing
, accountData = Nothing
, unreadNotifications = Nothing
}
newRooms = Just <| case sr.rooms of
Just rs -> { rs | join = newJoin rs.join }
Nothing -> { join = newJoin Nothing, leave = Nothing, invite = Nothing }
newJoin j = Maybe.map (Dict.update r appendMaybeRoomHistoryResponse) j
in
{ 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
colonIndex = Maybe.withDefault 0
<| Maybe.map ((+) 1)
<| List.head
<| String.indexes ":" s
in
String.dropLeft colonIndex s
-- Business Logic: Events -- Business Logic: Events
allRoomStateEvents : JoinedRoom -> List StateEvent
allRoomStateEvents jr =
let
stateEvents = Maybe.withDefault [] <| Maybe.andThen .events jr.state
timelineEvents = Maybe.withDefault [] <| Maybe.andThen .events jr.timeline
roomToStateEvent re =
{ content = re.content
, type_ = re.type_
, eventId = re.eventId
, sender = re.sender
, originServerTs = re.originServerTs
, unsigned = re.unsigned
, prevContent = Nothing
, stateKey = ""
}
allStateEvents = uniqueBy .eventId (stateEvents ++ (List.map roomToStateEvent timelineEvents))
in
allStateEvents
allRoomDictTimelineEvents : Dict String { a | timeline : Maybe Timeline } -> List RoomEvent allRoomDictTimelineEvents : Dict String { a | timeline : Maybe Timeline } -> List RoomEvent
allRoomDictTimelineEvents dict = List.concatMap (Maybe.withDefault [] << .events) allRoomDictTimelineEvents dict = List.concatMap (Maybe.withDefault [] << .events)
<| List.filterMap .timeline <| List.filterMap .timeline
<| Dict.values dict <| Dict.values dict
allTimelineEventIds : SyncResponse -> List String allTimelineEventIds : SyncResponse -> List String
allTimelineEventIds s = List.map .eventId <| allTimelineEvents s allTimelineEventIds s = List.map getEventId <| allTimelineEvents s
allTimelineEvents : SyncResponse -> List RoomEvent allTimelineEvents : SyncResponse -> List RoomEvent
allTimelineEvents s = allTimelineEvents s =
@@ -474,7 +76,7 @@ allTimelineEvents s =
joinedEvents = eventsFor .join joinedEvents = eventsFor .join
leftEvents = eventsFor .leave leftEvents = eventsFor .leave
in in
uniqueBy .eventId <| leftEvents ++ joinedEvents leftEvents ++ joinedEvents
joinedRoomsTimelineEvents : SyncResponse -> Dict String (List RoomEvent) joinedRoomsTimelineEvents : SyncResponse -> Dict String (List RoomEvent)
joinedRoomsTimelineEvents s = joinedRoomsTimelineEvents s =
@@ -482,65 +84,6 @@ joinedRoomsTimelineEvents s =
<| Maybe.map (Dict.map (\k v -> Maybe.withDefault [] <| Maybe.andThen .events v.timeline)) <| Maybe.map (Dict.map (\k v -> Maybe.withDefault [] <| Maybe.andThen .events v.timeline))
<| Maybe.andThen .join s.rooms <| Maybe.andThen .join s.rooms
totalNotificationCountString : SyncResponse -> Maybe String
totalNotificationCountString sr =
let
(h, n) = totalNotificationCounts sr
suffix = case h of
0 -> ""
_ -> "!"
in
case n of
0 -> Nothing
_ -> Just <| "(" ++ String.fromInt n ++ suffix ++ ")"
totalNotificationCounts : SyncResponse -> (Int, Int)
totalNotificationCounts sr =
let
rooms = Maybe.withDefault []
<| Maybe.map (Dict.values)
<| Maybe.andThen (.join) sr.rooms
zeroDefault = Maybe.withDefault 0
getCounts = Maybe.map (\cs -> (zeroDefault cs.highlightCount, zeroDefault cs.notificationCount))
<< .unreadNotifications
sumCounts (h1, n1) (h2, n2) = (h1 + h2, n1 + n2)
in
List.foldl sumCounts (0, 0)
<| List.filterMap getCounts rooms
-- Business Logic: Room Info
roomAccountData : JoinedRoom -> String -> Maybe Decode.Value
roomAccountData jr et =
Maybe.map .content
<| Maybe.andThen (List.head << List.filter (((==) et) << .type_))
<| Maybe.andThen .events jr.accountData
roomName : JoinedRoom -> Maybe String
roomName jr =
let
name c = Result.toMaybe <| Decode.decodeValue (field "name" string) c
nameEvent = findLastEvent (((==) "m.room.name") << .type_) <| allRoomStateEvents jr
in
Maybe.andThen (name << .content) nameEvent
roomTypingUsers : JoinedRoom -> List Username
roomTypingUsers jr = Maybe.withDefault []
<| Maybe.andThen (Result.toMaybe << Decode.decodeValue (Decode.field "user_ids" (list string)))
<| Maybe.map .content
<| Maybe.andThen (findLast (((==) "m.typing") << .type_))
<| Maybe.andThen .events jr.ephemeral
-- Business Logic: Users -- Business Logic: Users
allUsers : SyncResponse -> List Username allUsers : SyncResponse -> List Username
allUsers s = uniqueBy (\u -> u) <| List.map .sender <| allTimelineEvents s allUsers s = uniqueBy (\u -> u) <| List.map getSender <| allTimelineEvents s
roomJoinedUsers : JoinedRoom -> List Username
roomJoinedUsers r =
let
contentDecoder = Decode.field "membership" Decode.string
isJoin e = Ok "join" == (Decode.decodeValue contentDecoder e.content)
in
List.map .sender
<| List.filter isJoin
<| List.filter (((==) "m.room.member") << .type_)
<| allRoomStateEvents r

View File

@@ -0,0 +1,54 @@
module Scylla.Sync.AccountData exposing (..)
import Scylla.ListUtils exposing (..)
import Scylla.Sync.DecodeTools exposing (maybeDecode)
import Scylla.Sync.Events exposing (Event, eventDecoder)
import Scylla.Sync.Push exposing (Ruleset, rulesetDecoder)
import Json.Decode as Decode exposing (Decoder, list, field, decodeValue)
import Dict exposing (Dict)
type alias AccountData =
{ events : Maybe (List Event)
}
accountDataDecoder : Decoder AccountData
accountDataDecoder =
Decode.succeed AccountData
|> maybeDecode "events" (list eventDecoder)
type alias DirectMessages = Dict String String
directMessagesDecoder : Decode.Decoder DirectMessages
directMessagesDecoder =
Decode.dict (Decode.list Decode.string)
|> Decode.map (invertDirectMessages)
type alias DirectMessagesRaw = Dict String (List String)
invertDirectMessages : DirectMessagesRaw -> DirectMessages
invertDirectMessages dmr =
Dict.foldl
(\k lv acc -> List.foldl (\v -> Dict.insert v k) acc lv)
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_))
|> Maybe.map .content
|> Maybe.andThen (Result.toMaybe << decodeValue d)
getDirectMessages : AccountData -> Maybe DirectMessages
getDirectMessages = getAccountData "m.direct" directMessagesDecoder
getPushRuleset : AccountData -> Maybe Ruleset
getPushRuleset = getAccountData "m.push_rules" (field "global" rulesetDecoder)

View File

@@ -0,0 +1,9 @@
module Scylla.Sync.DecodeTools exposing (..)
import Json.Decode as Decode exposing (Decoder)
import Json.Decode.Pipeline exposing (optional)
decodeJust : Decoder a -> Decoder (Maybe a)
decodeJust = Decode.map Just
maybeDecode : String -> Decoder a -> Decoder (Maybe a -> b) -> Decoder b
maybeDecode s d = optional s (decodeJust d) Nothing

149
src/Scylla/Sync/Events.elm Normal file
View File

@@ -0,0 +1,149 @@
module Scylla.Sync.Events exposing (..)
import Scylla.Sync.DecodeTools exposing (maybeDecode)
import Json.Decode as Decode exposing (Decoder, int, string, value, oneOf)
import Json.Decode.Pipeline exposing (required)
type alias UnsignedData =
{ age : Maybe Int
, redactedBecause : Maybe Event
, transactionId : Maybe String
}
unsignedDataDecoder : Decoder UnsignedData
unsignedDataDecoder =
Decode.succeed UnsignedData
|> maybeDecode "age" int
|> maybeDecode "redacted_because" eventDecoder
|> maybeDecode "transaction_id" string
type alias EventContent = Decode.Value
eventContentDecoder : Decoder EventContent
eventContentDecoder = Decode.value
type alias Event =
{ content : Decode.Value
, type_ : String
}
eventDecoder : Decoder Event
eventDecoder =
Decode.succeed Event
|> required "content" value
|> required "type" string
type RoomEvent
= StateRoomEvent StateEvent
| MessageRoomEvent MessageEvent
roomEventDecoder : Decoder RoomEvent
roomEventDecoder = oneOf
[ Decode.map StateRoomEvent stateEventDecoder
, Decode.map MessageRoomEvent messageEventDecoder
]
type alias MessageEvent =
{ content : EventContent
, type_ : String
, eventId : String
, sender : String
, originServerTs : Int
, unsigned : Maybe UnsignedData
}
messageEventDecoder : Decoder MessageEvent
messageEventDecoder =
Decode.succeed MessageEvent
|> required "content" value
|> required "type" string
|> required "event_id" string
|> required "sender" string
|> required "origin_server_ts" int
|> maybeDecode "unsigned" unsignedDataDecoder
type alias StateEvent =
{ content : EventContent
, type_ : String
, eventId : String
, sender : String
, originServerTs : Int
, unsigned : Maybe UnsignedData
, prevContent : Maybe EventContent
, stateKey : String
}
stateEventDecoder : Decoder StateEvent
stateEventDecoder =
Decode.succeed StateEvent
|> required "content" value
|> required "type" string
|> required "event_id" string
|> required "sender" string
|> required "origin_server_ts" int
|> maybeDecode "unsigned" unsignedDataDecoder
|> maybeDecode "prev_content" eventContentDecoder
|> required "state_key" string
type alias StrippedStateEvent =
{ content : EventContent
, stateKey : String
, type_ : String
, sender : String
}
strippedStateEventDecoder : Decoder StrippedStateEvent
strippedStateEventDecoder =
Decode.succeed StrippedStateEvent
|> required "content" eventContentDecoder
|> required "state_key" string
|> required "type" string
|> required "sender" string
-- Operations on Room Events
getUnsigned : RoomEvent -> Maybe UnsignedData
getUnsigned re =
case re of
StateRoomEvent e -> e.unsigned
MessageRoomEvent e -> e.unsigned
getEventId : RoomEvent -> String
getEventId re =
case re of
StateRoomEvent e -> e.eventId
MessageRoomEvent e -> e.eventId
getSender : RoomEvent -> String
getSender re =
case re of
StateRoomEvent e -> e.sender
MessageRoomEvent e -> e.sender
getType : RoomEvent -> String
getType re =
case re of
StateRoomEvent 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 re =
case re of
StateRoomEvent e -> Just e
_ -> Nothing
toMessageEvent : RoomEvent -> Maybe MessageEvent
toMessageEvent re =
case re of
MessageRoomEvent e -> Just e
_ -> Nothing
toEvent : RoomEvent -> Event
toEvent re =
case re of
StateRoomEvent e -> { content = e.content, type_ = e.type_ }
MessageRoomEvent e -> { content = e.content, type_ = e.type_ }

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

109
src/Scylla/Sync/Rooms.elm Normal file
View File

@@ -0,0 +1,109 @@
module Scylla.Sync.Rooms exposing (..)
import Scylla.Sync.DecodeTools exposing (maybeDecode)
import Scylla.Sync.Events exposing (Event, RoomEvent, StateEvent, StrippedStateEvent, stateEventDecoder, strippedStateEventDecoder, roomEventDecoder, eventDecoder)
import Scylla.Sync.AccountData exposing (AccountData, accountDataDecoder)
import Json.Decode as Decode exposing (Decoder, int, string, dict, list, bool)
import Json.Decode.Pipeline exposing (required)
import Dict exposing (Dict)
type alias Rooms =
{ join : Maybe (Dict String JoinedRoom)
, invite : Maybe (Dict String InvitedRoom)
, leave : Maybe (Dict String LeftRoom)
}
roomsDecoder : Decoder Rooms
roomsDecoder =
Decode.succeed Rooms
|> maybeDecode "join" (dict joinedRoomDecoder)
|> maybeDecode "invite" (dict invitedRoomDecoder)
|> maybeDecode "leave" (dict leftRoomDecoder)
type alias JoinedRoom =
{ state : Maybe State
, timeline : Maybe Timeline
, ephemeral : Maybe Ephemeral
, accountData : Maybe AccountData
, unreadNotifications : Maybe UnreadNotificationCounts
}
joinedRoomDecoder : Decoder JoinedRoom
joinedRoomDecoder =
Decode.succeed JoinedRoom
|> maybeDecode "state" stateDecoder
|> maybeDecode "timeline" timelineDecoder
|> maybeDecode "ephemeral" ephemeralDecoder
|> maybeDecode "account_data" accountDataDecoder
|> maybeDecode "unread_notifications" unreadNotificationCountsDecoder
type alias InvitedRoom =
{ inviteState : Maybe InviteState
}
invitedRoomDecoder : Decoder InvitedRoom
invitedRoomDecoder =
Decode.succeed InvitedRoom
|> maybeDecode "invite_state" inviteStateDecoder
type alias LeftRoom =
{ state : Maybe State
, timeline : Maybe Timeline
, accountData : Maybe AccountData
}
leftRoomDecoder : Decoder LeftRoom
leftRoomDecoder =
Decode.succeed LeftRoom
|> maybeDecode "state" stateDecoder
|> maybeDecode "timeline" timelineDecoder
|> maybeDecode "account_data" accountDataDecoder
type alias State =
{ events : Maybe (List StateEvent)
}
stateDecoder : Decoder State
stateDecoder =
Decode.succeed State
|> maybeDecode "events" (list stateEventDecoder)
type alias InviteState =
{ events : Maybe (List StrippedStateEvent)
}
inviteStateDecoder : Decoder InviteState
inviteStateDecoder =
Decode.succeed InviteState
|> maybeDecode "events" (list strippedStateEventDecoder)
type alias Timeline =
{ events : Maybe (List RoomEvent)
, limited : Maybe Bool
, prevBatch : Maybe String
}
timelineDecoder =
Decode.succeed Timeline
|> maybeDecode "events" (list roomEventDecoder)
|> maybeDecode "limited" bool
|> maybeDecode "prev_batch" string
type alias Ephemeral =
{ events : Maybe (List Event)
}
ephemeralDecoder : Decoder Ephemeral
ephemeralDecoder =
Decode.succeed Ephemeral
|> maybeDecode "events" (list eventDecoder)
type alias UnreadNotificationCounts =
{ highlightCount : Maybe Int
, notificationCount : Maybe Int
}
unreadNotificationCountsDecoder : Decoder UnreadNotificationCounts
unreadNotificationCountsDecoder =
Decode.succeed UnreadNotificationCounts
|> maybeDecode "highlight_count" int
|> maybeDecode "notification_count" int

View File

@@ -1,6 +1,8 @@
module Scylla.UserData exposing (..) 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 as Decode exposing (Decoder, int, string, float, list, value, dict, bool, field)
import Json.Decode.Pipeline exposing (required, optional) import Json.Decode.Pipeline exposing (required, optional)
import Dict exposing (Dict)
type alias UserData = type alias UserData =
{ displayName : Maybe String { displayName : Maybe String
@@ -12,3 +14,13 @@ userDataDecoder =
Decode.succeed UserData Decode.succeed UserData
|> 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
getSenderName : Username -> String
getSenderName s =
let
colonIndex = Maybe.withDefault -1
<| List.head
<| String.indexes ":" s
in
String.slice 1 colonIndex s

View File

@@ -1,13 +1,16 @@
module Scylla.Views exposing (..) module Scylla.Views exposing (..)
import Scylla.Model exposing (..) import Scylla.Model exposing (..)
import Scylla.Sync exposing (..) import Scylla.Sync exposing (..)
import Scylla.Sync.Events exposing (..)
import Scylla.Sync.Rooms exposing (..)
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.Room exposing (..)
import Scylla.Messages exposing (..) import Scylla.Messages exposing (..)
import Scylla.Login exposing (Username) import Scylla.Login exposing (Username)
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 Html.Parser import Html.Parser
import Html.Parser.Util import Html.Parser.Util
import Svg import Svg
@@ -17,6 +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 (lazy5)
import Dict exposing (Dict) import Dict exposing (Dict)
import Tuple import Tuple
@@ -43,8 +47,8 @@ stringColor s =
viewFull : Model -> List (Html Msg) viewFull : Model -> List (Html Msg)
viewFull model = viewFull model =
let let
room r = Maybe.map (\rd -> (r, rd)) room r = Dict.get r model.rooms
<| roomData model r |> Maybe.map (\rd -> (r, rd))
core = case model.route of core = case model.route of
Login -> loginView model Login -> loginView model
Base -> baseView model Nothing Base -> baseView model Nothing
@@ -60,10 +64,10 @@ errorsView = div [ class "errors-wrapper" ] << List.indexedMap errorView
errorView : Int -> String -> Html Msg errorView : Int -> String -> Html Msg
errorView i s = div [ class "error-wrapper", onClick <| DismissError i ] [ iconView "alert-triangle", text s ] errorView i s = div [ class "error-wrapper", onClick <| DismissError i ] [ iconView "alert-triangle", text s ]
baseView : Model -> Maybe (String, RoomData) -> Html Msg baseView : Model -> Maybe (RoomId, RoomData) -> Html Msg
baseView m jr = baseView m rd =
let let
roomView = Maybe.map (\(id, r) -> joinedRoomView m id r) jr roomView = Maybe.map (\(id, r) -> joinedRoomView m id r) rd
reconnect = reconnectView m reconnect = reconnectView m
in in
div [ class "base-wrapper" ] <| maybeHtml div [ class "base-wrapper" ] <| maybeHtml
@@ -80,11 +84,8 @@ reconnectView m = if m.connected
roomListView : Model -> Html Msg roomListView : Model -> Html Msg
roomListView m = roomListView m =
let let
rooms = Maybe.withDefault (Dict.empty)
<| Maybe.andThen .join
<| m.sync.rooms
groups = roomGroups groups = roomGroups
<| Dict.toList rooms <| Dict.toList m.rooms
homeserverList = div [ class "homeservers-list" ] homeserverList = div [ class "homeservers-list" ]
<| List.map (\(k, v) -> homeserverView m k v) <| List.map (\(k, v) -> homeserverView m k v)
<| Dict.toList groups <| Dict.toList groups
@@ -101,26 +102,26 @@ roomListView m =
, homeserverList , homeserverList
] ]
roomGroups : List (String, JoinedRoom) -> Dict String (List (String, JoinedRoom)) roomGroups : List (String, RoomData) -> Dict String (List (String, RoomData))
roomGroups jrs = groupBy (homeserver << Tuple.first) jrs roomGroups jrs = groupBy (getHomeserver << Tuple.first) jrs
homeserverView : Model -> String -> List (String, JoinedRoom) -> Html Msg homeserverView : Model -> String -> List (String, RoomData) -> Html Msg
homeserverView m hs rs = 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 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 -> String -> JoinedRoom -> Html Msg roomListElementView : Model -> RoomId -> RoomData -> Html Msg
roomListElementView m s jr = roomListElementView m rid rd =
let let
name = roomDisplayName m jr 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
Just cr -> cr == s Just cr -> cr == rid
in in
div [ classList div [ classList
[ ("room-link-wrapper", True) [ ("room-link-wrapper", True)
@@ -128,10 +129,10 @@ roomListElementView m s jr =
, ("hidden", not isVisible) , ("hidden", not isVisible)
] ]
] ]
<| roomNotificationCountView jr.unreadNotifications ++ <| roomNotificationCountView rd.unreadNotifications ++
[ a [ href <| roomUrl s ] [ text name ] ] [ a [ href <| roomUrl rid ] [ text name ] ]
roomNotificationCountView : Maybe UnreadNotificationCounts -> List (Html Msg) roomNotificationCountView : UnreadNotificationCounts -> List (Html Msg)
roomNotificationCountView ns = roomNotificationCountView ns =
let let
wrap b = span wrap b = span
@@ -140,7 +141,7 @@ roomNotificationCountView ns =
, ("bright", b) , ("bright", b)
] ]
] ]
getCount f = Maybe.withDefault 0 << Maybe.andThen f getCount f = Maybe.withDefault 0 << f
in in
case (getCount .notificationCount ns, getCount .highlightCount ns) of case (getCount .notificationCount ns, getCount .highlightCount ns) of
(0, 0) -> [] (0, 0) -> []
@@ -159,9 +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
renderedMessages = List.map (userMessagesView m) <| mergeMessages m.loginUsername <| extractMessages rd typing = List.map (getLocalDisplayName rd) <| getRoomTypingUsers rd
messagesWrapper = messagesWrapperView m roomId renderedMessages
typing = List.map (displayName m) <| roomTypingUsers rd.joinedRoom
typingText = String.join ", " typing typingText = String.join ", " typing
typingSuffix = case List.length typing of typingSuffix = case List.length typing of
0 -> "" 0 -> ""
@@ -182,12 +181,23 @@ joinedRoomView m roomId rd =
] ]
in in
div [ class "room-wrapper" ] div [ class "room-wrapper" ]
[ h2 [] [ text <| roomDisplayName m rd.joinedRoom ] [ h2 [] [ text <| getRoomName m.accountData roomId rd ]
, messagesWrapper , lazy5 lazyMessagesView roomId rd m.apiUrl m.loginUsername m.sending
, messageInput , messageInput
, typingWrapper , typingWrapper
] ]
lazyMessagesView : RoomId -> RoomData -> ApiUrl -> Username -> Dict Int (RoomId, SendingMessage) -> Html Msg
lazyMessagesView rid rd au lu snd =
let
roomReceived = getReceivedMessages rd
roomSending = getSendingMessages rid snd
renderedMessages = List.map (userMessagesView rd au)
<| groupMessages lu
<| roomReceived ++ roomSending
in
messagesWrapperView rid renderedMessages
onEnterKey : Msg -> Attribute Msg onEnterKey : Msg -> Attribute Msg
onEnterKey msg = onEnterKey msg =
let let
@@ -207,81 +217,99 @@ iconView name =
[ Svg.Attributes.class "feather-icon" [ Svg.Attributes.class "feather-icon"
] [ Svg.use [ Svg.Attributes.xlinkHref (url ++ "#" ++ name) ] [] ] ] [ Svg.use [ Svg.Attributes.xlinkHref (url ++ "#" ++ name) ] [] ]
messagesWrapperView : Model -> RoomId -> List (Html Msg) -> Html Msg messagesWrapperView : RoomId -> List (Html Msg) -> Html Msg
messagesWrapperView m rid es = div [ class "messages-wrapper", id "messages-wrapper" ] messagesWrapperView rid es = div [ class "messages-wrapper", id "messages-wrapper" ]
[ a [ class "history-link", onClick <| History rid ] [ text "Load older messages" ] [ a [ class "history-link", onClick <| History rid ] [ text "Load older messages" ]
, table [ class "messages-table" ] es , table [ class "messages-table" ] es
] ]
senderView : Model -> Username -> Html Msg senderView : RoomData -> Username -> Html Msg
senderView m s = senderView rd s =
span [ style "color" <| stringColor s, class "sender-wrapper" ] [ text <| displayName m s ] span [ style "color" <| stringColor s, class "sender-wrapper" ] [ text <| getLocalDisplayName rd s ]
userMessagesView : Model -> (Username, List Message) -> Html Msg userMessagesView : RoomData -> ApiUrl -> (Username, List Message) -> Html Msg
userMessagesView m (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 m u ] [ td [] [ senderView rd u ]
, td [] <| List.map wrap <| List.filterMap (messageView m) ms , td [] <| List.map wrap <| List.filterMap (messageView rd apiUrl) ms
] ]
messageView : Model -> Message -> Maybe (Html Msg) messageView : RoomData -> ApiUrl -> Message -> Maybe (Html Msg)
messageView m msg = case msg of messageView rd apiUrl msg = case msg of
Sending t -> Just <| sendingMessageView m t Sending t -> Just <| sendingMessageView t
Received re -> roomEventView m re Received re -> roomEventView rd apiUrl re
sendingMessageView : Model -> SendingMessage -> Html Msg sendingMessageView : SendingMessage -> Html Msg
sendingMessageView m 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 : Model -> RoomEvent -> Maybe (Html Msg) roomEventView : RoomData -> ApiUrl -> MessageEvent -> Maybe (Html Msg)
roomEventView m 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 m re Ok "m.text" -> roomEventTextView re
Ok "m.image" -> roomEventImageView m re Ok "m.notice" -> roomEventNoticeView re
Ok "m.file" -> roomEventFileView m re Ok "m.emote" -> roomEventEmoteView rd re
Ok "m.video" -> roomEventVideoView m re Ok "m.image" -> roomEventImageView apiUrl re
Ok "m.file" -> roomEventFileView apiUrl re
Ok "m.video" -> roomEventVideoView apiUrl re
_ -> Nothing _ -> Nothing
roomEventTextView : Model -> RoomEvent -> Maybe (Html Msg) roomEventFormattedContent : MessageEvent -> Maybe (List (Html Msg))
roomEventTextView m re = roomEventFormattedContent re = Maybe.map Html.Parser.Util.toVirtualDom
let
body = Decode.decodeValue (Decode.field "body" Decode.string) re.content
customHtml = Maybe.map Html.Parser.Util.toVirtualDom
<| Maybe.andThen (Result.toMaybe << Html.Parser.run ) <| Maybe.andThen (Result.toMaybe << Html.Parser.run )
<| Result.toMaybe <| Result.toMaybe
<| Decode.decodeValue (Decode.field "formatted_body" Decode.string) re.content <| Decode.decodeValue (Decode.field "formatted_body" Decode.string) re.content
roomEventContent : (List (Html Msg) -> Html Msg) -> MessageEvent -> Maybe (Html Msg)
roomEventContent f re =
let
body = Decode.decodeValue (Decode.field "body" Decode.string) re.content
customHtml = roomEventFormattedContent re
in in
case customHtml of case customHtml of
Just c -> Just <| div [] c Just c -> Just <| f c
Nothing -> Maybe.map (p [] << List.singleton << text) <| Result.toMaybe body Nothing -> Maybe.map (f << List.singleton << text) <| Result.toMaybe body
roomEventImageView : Model -> RoomEvent -> Maybe (Html Msg) roomEventEmoteView : RoomData -> MessageEvent -> Maybe (Html Msg)
roomEventImageView m re = roomEventEmoteView rd re =
let
emoteText = "* " ++ getLocalDisplayName rd re.sender ++ " "
in
roomEventContent (\cs -> span [] (text emoteText :: cs)) re
roomEventNoticeView : MessageEvent -> Maybe (Html Msg)
roomEventNoticeView = roomEventContent (span [ class "message-notice" ])
roomEventTextView : MessageEvent -> Maybe (Html Msg)
roomEventTextView = roomEventContent (span [])
roomEventImageView : ApiUrl -> MessageEvent -> Maybe (Html Msg)
roomEventImageView apiUrl re =
let let
body = Decode.decodeValue (Decode.field "url" Decode.string) re.content body = Decode.decodeValue (Decode.field "url" Decode.string) re.content
in in
Maybe.map (\s -> img [ class "message-image", src s ] []) Maybe.map (\s -> img [ class "message-image", src s ] [])
<| Maybe.map (contentRepositoryDownloadUrl m.apiUrl) <| Maybe.map (contentRepositoryDownloadUrl apiUrl)
<| Result.toMaybe body <| Result.toMaybe body
roomEventFileView : Model -> RoomEvent -> Maybe (Html Msg) roomEventFileView : ApiUrl -> MessageEvent -> Maybe (Html Msg)
roomEventFileView m re = roomEventFileView apiUrl re =
let let
decoder = Decode.map2 (\l r -> (l, r)) (Decode.field "url" Decode.string) (Decode.field "body" Decode.string) decoder = Decode.map2 (\l r -> (l, r)) (Decode.field "url" Decode.string) (Decode.field "body" Decode.string)
fileData = Decode.decodeValue decoder re.content fileData = Decode.decodeValue decoder re.content
in in
Maybe.map (\(url, name) -> a [ href url, class "file-wrapper" ] [ iconView "file", text name ]) Maybe.map (\(url, name) -> a [ href url, class "file-wrapper" ] [ iconView "file", text name ])
<| Maybe.map (\(url, name) -> (contentRepositoryDownloadUrl m.apiUrl url, name)) <| Maybe.map (\(url, name) -> (contentRepositoryDownloadUrl apiUrl url, name))
<| Result.toMaybe fileData <| Result.toMaybe fileData
roomEventVideoView : Model -> RoomEvent -> Maybe (Html Msg) roomEventVideoView : ApiUrl -> MessageEvent -> Maybe (Html Msg)
roomEventVideoView m re = roomEventVideoView apiUrl re =
let let
decoder = Decode.map2 (\l r -> (l, r)) decoder = Decode.map2 (\l r -> (l, r))
(Decode.field "url" Decode.string) (Decode.field "url" Decode.string)
@@ -289,5 +317,5 @@ roomEventVideoView m re =
videoData = Decode.decodeValue decoder re.content videoData = Decode.decodeValue decoder re.content
in in
Maybe.map (\(url, t) -> video [ controls True ] [ source [ src url, type_ t ] [] ]) Maybe.map (\(url, t) -> video [ controls True ] [ source [ src url, type_ t ] [] ])
<| Maybe.map (\(url, type_) -> (contentRepositoryDownloadUrl m.apiUrl url, type_)) <| Maybe.map (\(url, type_) -> (contentRepositoryDownloadUrl apiUrl url, type_))
<| Result.toMaybe videoData <| Result.toMaybe videoData

View File

@@ -0,0 +1,3 @@
@import 'mixins';
@import 'variables';

12
static/scss/mixins.scss Normal file
View File

@@ -0,0 +1,12 @@
@mixin input-common {
padding: 5px;
border-radius: $border-radius;
outline: none;
font-family: inherit;
font-size: inherit;
&:focus {
transition: background-color $transition-duration;
}
}

View File

@@ -1,22 +1,7 @@
@import url('https://fonts.googleapis.com/css?family=Open+Sans|Source+Code+Pro'); @import url('https://fonts.googleapis.com/css?family=Open+Sans|Source+Code+Pro');
$primary-color: #53C0FA; @import 'mixins';
$primary-color-highlight: #4298C7; @import 'variables';
$primary-color-light: #9FDBFB; @import 'components';
$background-color: #1b1e21;
$background-color-light: lighten($background-color, 4%);
$background-color-dark: darken($background-color, 4%);
$error-color: #f01d43;
$error-color-dark: darken(#f01d43, 10%);
$alert-color: #18f49c;
$alert-color-bright: rgb(240, 244, 24);
$inactive-input-color: lighten($background-color-light, 5%);
$active-input-color: lighten($inactive-input-color, 5%);
$transition-duration: .250s;
$inset-shadow: inset 0px 0px 5px rgba(0, 0, 0, .25);
$border-radius: 3px;
html, body { html, body {
height: 100vh; height: 100vh;
@@ -24,32 +9,19 @@ html, body {
body { body {
font-family: 'Open Sans', sans-serif; font-family: 'Open Sans', sans-serif;
margin: 0px; margin: 0;
background-color: $background-color; background-color: $background-color;
font-size: 12px; font-size: .7em;
color: white; color: white;
} }
@mixin input-common {
padding: 5px;
border-radius: $border-radius;
outline: none;
font-family: inherit;
font-size: inherit;
&:focus {
transition: background-color $transition-duration;
}
}
input, textarea { input, textarea {
@include input-common(); @include input-common();
overflow-x: hidden; overflow-x: hidden;
background-color: $inactive-input-color; background-color: $inactive-input-color;
color: white; color: white;
border: none; border: none;
padding: 10px; padding: .5em;
&:focus { &:focus {
background-color: $active-input-color; background-color: $active-input-color;
@@ -68,6 +40,7 @@ button {
} }
} }
a { a {
text-decoration: none; text-decoration: none;
color: $primary-color; color: $primary-color;
@@ -77,50 +50,43 @@ a {
} }
} }
h2, h3 { h1, h2, h3, h4, h5, h6 {
margin: 0px; margin: 0;
margin-bottom: 3px; margin-bottom: .5em;
}
a.file-wrapper {
padding: 5px 0px 5px 0px;
display: flex;
align-items: center;
.feather-icon {
height: 30px;
width: 30px;
margin-right: 10px;
}
} }
/*
* Errors
*/
div.errors-wrapper { div.errors-wrapper {
position: fixed; position: fixed;
pointer-events: none; pointer-events: none;
top: 0px; top: 0;
bottom: 0px; bottom: 0;
left: 0px; left: 0;
right: 0px; right: 0;
overflow: hidden; overflow: hidden;
} }
div.error-wrapper { div.error-wrapper {
pointer-events: auto; pointer-events: auto;
width: 400px; width: 40%;
padding: 5px; padding: .5em;
background-color: $error-color; background-color: $error-color;
border: 1px solid $error-color-dark; border: .1em solid $error-color-dark;
color: white; color: white;
margin: auto; margin: auto;
margin-top: 10px; margin-top: .85em;
margin-bottom: 10px; margin-bottom: .85em;
font-size: 14px; font-size: 1em;
display: flex;
align-items: center; align-items: center;
overflow-x: hidden;
white-space: nowrap;
text-overflow: ellipsis;
.feather-icon { .feather-icon {
margin-right: 10px; margin-right: .85em;
} }
} }
@@ -130,12 +96,12 @@ div.error-wrapper {
div.login-wrapper { div.login-wrapper {
display: flex; display: flex;
flex-direction: column; flex-direction: column;
max-width: 300px; max-width: 30%;
margin: auto; margin: auto;
margin-top: 20px; margin-top: 1.5em;
input, button { input, button {
margin: 3px; margin: .3em;
} }
} }
@@ -145,24 +111,25 @@ div.login-wrapper {
div.base-wrapper { div.base-wrapper {
display: flex; display: flex;
height: 100%; height: 100%;
> div {
padding: 10px;
box-sizing: border-box;
}
} }
/* /*
* The list of rooms * The list of rooms
*/ */
div.rooms-container {
border-right: .1em solid $background-color-dark;
}
div.rooms-wrapper { div.rooms-wrapper {
flex-shrink: 0; flex-shrink: 0;
width: 15%; width: 15%;
min-width: 200px; min-width: 20em;
background-color: $background-color-light; padding: .85em;
box-sizing: border-box;
border-right: .1em solid $background-color-dark;
.room-search { .room-search {
padding: 5px; padding: .5em;
width: 100%; width: 100%;
box-sizing: border-box; box-sizing: border-box;
} }
@@ -170,23 +137,21 @@ div.rooms-wrapper {
div.room-link-wrapper { div.room-link-wrapper {
whitespace: nowrap; whitespace: nowrap;
border-left: solid .2em $background-color;
padding-left: .5em;
margin: .3em;
display: flex; display: flex;
padding: 0px;
border-left: solid 2px $background-color-light;
padding-left: 5px;
margin: 3px;
align-items: center; align-items: center;
.feather-icon { .feather-icon {
margin-right: 3px;
height: 1.2em; height: 1.2em;
} }
span { span.notification-count {
color: $alert-color; color: $alert-color;
margin-right: .5em;
display: flex; display: flex;
align-items: center; align-items: center;
margin-right: 5px;
&.bright { &.bright {
color: $alert-color-bright; color: $alert-color-bright;
@@ -206,7 +171,7 @@ div.room-link-wrapper {
} }
&.active { &.active {
border-left: solid 2px $primary-color; border-left: solid .2em $primary-color;
} }
&.hidden { &.hidden {
@@ -216,15 +181,16 @@ div.room-link-wrapper {
div.reconnect-wrapper { div.reconnect-wrapper {
position: fixed; position: fixed;
bottom: 20px; bottom: 1.5em;
left: 20px; left: 1.5em;
padding: .85em;
display: flex; display: flex;
align-items: center; align-items: center;
background-color: $inactive-input-color; background-color: $inactive-input-color;
border-radius: $border-radius; border-radius: $border-radius;
.feather-icon { .feather-icon {
margin-right: 10px; margin-right: .85em;
} }
} }
@@ -232,36 +198,38 @@ div.reconnect-wrapper {
* The current room, if any. * The current room, if any.
*/ */
div.room-wrapper { div.room-wrapper {
flex-grow: 1;
display: flex; display: flex;
height: 100%;
flex-direction: column; flex-direction: column;
padding: 5px; padding: .85em;
} }
div.typing-wrapper { div.typing-wrapper {
padding: 5px; padding: .5em;
height: 1em; height: 1em;
flex-shrink: 0; flex-shrink: 0;
} }
/*
* The message input and send button.
*/
div.message-wrapper { div.message-wrapper {
display: flex; display: flex;
flex-shrink: 0; flex-shrink: 0;
input, textarea { input, textarea {
flex-grow: 12; flex-grow: 12;
margin: 3px; margin: .3em;
} }
button { button {
margin: 3px; margin: .3em;
height: 40px; height: 3em;
width: 40px; width: 3em;
transition: background-color $transition-duration; transition: color $transition-duration;
background-color: $background-color;
color: $primary-color;
&:hover {
color: $primary-color-light;
}
} }
} }
@@ -274,7 +242,7 @@ div.messages-wrapper {
width: 100%; width: 100%;
text-align: center; text-align: center;
box-sizing: border-box; box-sizing: border-box;
padding: 5px; padding: .5em;
} }
} }
@@ -284,16 +252,16 @@ table.messages-table {
table-layout: fixed; table-layout: fixed;
td { td {
padding: 5px; padding: .5em;
vertical-align: top; vertical-align: top;
} }
img { img {
max-width: 90%; max-width: 90%;
max-height: 400px; max-height: 30em;
margin-top: 10px; margin-top: .85em;
margin-bottom: 10px; margin-bottom: .85em;
box-shadow: 0px 0px 5px rgba(0, 0, 0, .5); box-shadow: 0 0 .5em rgba(0, 0, 0, .5);
} }
.sending { .sending {
@@ -302,27 +270,24 @@ table.messages-table {
video { video {
max-width: 90%; max-width: 90%;
max-height: 400px; max-height: 30em;
} }
td:nth-child(1) { td:nth-child(1) {
width: 10%; width: 10%;
@media screen and (min-width: 1000px) {
width: 100px;
}
white-space: nowrap; white-space: nowrap;
} }
} }
div.message { div.message {
p { p {
margin: 0px; margin: 0;
} }
blockquote { blockquote {
margin: 0px 0px 0px 0px; margin: 0 0 0 0;
padding-left: 5px; padding-left: .5em;
border-left: 4px solid $primary-color; border-left: .4em solid $primary-color;
} }
code { code {
@@ -334,7 +299,7 @@ div.message {
overflow: auto; overflow: auto;
display: block; display: block;
box-sizing: border-box; box-sizing: border-box;
padding: 10px; padding: .85em;
background-color: $background-color-dark; background-color: $background-color-dark;
border-radius: $border-radius; border-radius: $border-radius;
box-shadow: $inset-shadow; box-shadow: $inset-shadow;
@@ -343,8 +308,8 @@ div.message {
span.sender-wrapper { span.sender-wrapper {
border-radius: $border-radius; border-radius: $border-radius;
padding-left: 5px; padding-left: .5em;
padding-right: 5px; padding-right: .5em;
display: inline-block; display: inline-block;
box-sizing: border-box; box-sizing: border-box;
text-align: right; text-align: right;
@@ -356,6 +321,23 @@ span.sender-wrapper {
color: black; color: black;
} }
a.file-wrapper {
padding: .5em 0 .5em 0;
display: flex;
align-items: center;
.feather-icon {
height: 2em;
width: 2em;
margin-right: .85em;
}
}
.message-notice {
text-transform: uppercase;
}
/** /**
* Icons * Icons
*/ */
@@ -366,6 +348,6 @@ span.sender-wrapper {
stroke-linecap: round; stroke-linecap: round;
stroke-linejoin: round; stroke-linejoin: round;
fill: none; fill: none;
height: 20px; height: 1.5em;
width: 20px; width: 1.5em;
} }

View File

@@ -0,0 +1,26 @@
// Colors
$primary-color: #53C0FA;
$primary-color-highlight: #4298C7;
$primary-color-light: #9FDBFB;
$background-color: #1b1e21;
$background-color-light: lighten($background-color, 4%);
$background-color-dark: darken($background-color, 4%);
$error-color: #f01d43;
$error-color-dark: darken(#f01d43, 10%);
$alert-color: #18f49c;
$alert-color-bright: rgb(240, 244, 24);
$inactive-input-color: lighten($background-color-light, 5%);
$active-input-color: lighten($inactive-input-color, 5%);
// Transitions
$transition-duration: .250s;
// Shadows
$inset-shadow: inset 0px 0px 5px rgba(0, 0, 0, .25);
// Borders
$border-radius: 3px;