Compare commits

..

1 Commits

Author SHA1 Message Date
36ad2cc93c Store the transaction ID locally, too. 2018-12-17 20:30:11 -08:00
35 changed files with 634 additions and 1944 deletions

17
.gitignore vendored
View File

@@ -1,17 +0,0 @@
/static/js/elm.js
/static/css/style.css
# Created by https://www.gitignore.io/api/elm,sass
# Edit at https://www.gitignore.io/?templates=elm,sass
### Elm ###
# elm-package generated files
elm-stuff
# elm-repl generated files
repl-temp-*
### Sass ###
.sass-cache/
*.css.map
*.sass.map
*.scss.map

21
LICENSE
View File

@@ -1,21 +0,0 @@
MIT License
Copyright (c) 2019 Danila Fedorin
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
SOFTWARE.

View File

@@ -1,53 +0,0 @@
# Scylla
A minimalist client for the Matrix chat protocol. Come chat with me: [![#scylla:riot.danilafe.com](https://img.shields.io/matrix/scylla:riot.danilafe.com.svg?label=%23scylla:riot.danilafe.com&server_fqdn=matrix.org)](https://matrix.to/#/#scylla:riot.danilafe.com)
## Screenshots
![Main View](screenshots/screenshot-1.png)
![Login View](screenshots/screenshot-2.png)
![Error](screenshots/screenshot-3.png)
## Why?
Riot, the flagship Matrix client, is slow. Switching rooms has a noticable delay (probably around several hundred milliseconds).
History loading causes strange jumps in the scroll position. Scylla aims to be faster and more responsive,
while still maintaining all the necessary features for a chat client.
## What can it do?
Scylla currently supports the following features:
* Sending and receiving messages
* Sending and receiving images and files
* Converting Markdown into HTML for specially formatted messages
* Loading old history in a room
## Should I use Scylla?
Maybe. Scylla aims for a more minimalistic experience, remeniscent of IRC. It doesn't strive to have the rich chat client features
that Riot goes for, and attempts to polish the common tasks. If you would like a more advanced chat client, stick with Riot. However,
if you prefer polished minimalism, Scylla might be the client for you.
## Building Instructions
If you'd like to build Scylla, you need to take the following steps:
1. Install [Elm](https://elm-lang.org/) and [Sass](https://sass-lang.com/)
2. Compile Scylla's Elm and Sass source files:
```
elm make src/Main.elm --output static/js/elm.js --optimize
sass static/scss/style.scss static/css/style.css
```
3. Open the provided `index.html` file in your browser. You can't do it by just loading the file in Chrome;
you need to use an actual web server. I use Python2's built in HTTP server as such:
```
python2 -m SimpleHTTPServer
```
If you use this, visit the address `localhost:8000` once the server starts.
4. If you'd like to host Scylla, you need to be aware that it uses URLs as paths.
Because of this, in order for refreshing the page to work as intended,
you need to make sure that all URLs that don't start with "static" serve the
same `index.html` file. I use the following (Apache) configuration:
```
RewriteEngine on
RewriteCond %{REQUEST_URI} !^/static/
RewriteRule .* "/path/to/Scylla/index.html"
```

View File

@@ -1,77 +0,0 @@
{
"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,26 +3,23 @@
"source-directories": [ "source-directories": [
"src" "src"
], ],
"elm-version": "0.19.1", "elm-version": "0.19.0",
"dependencies": { "dependencies": {
"direct": { "direct": {
"NoRedInk/elm-json-decode-pipeline": "1.0.0", "NoRedInk/elm-json-decode-pipeline": "1.0.0",
"elm/browser": "1.0.1", "elm/browser": "1.0.1",
"elm/core": "1.0.2", "elm/core": "1.0.2",
"elm/file": "1.0.1",
"elm/html": "1.0.0", "elm/html": "1.0.0",
"elm/http": "2.0.0", "elm/http": "2.0.0",
"elm/json": "1.1.2", "elm/json": "1.1.2",
"elm/svg": "1.0.1", "elm/svg": "1.0.1",
"elm/time": "1.0.0", "elm/time": "1.0.0",
"elm/url": "1.0.0", "elm/url": "1.0.0"
"hecrj/html-parser": "2.0.0"
}, },
"indirect": { "indirect": {
"elm/bytes": "1.0.7", "elm/bytes": "1.0.7",
"elm/parser": "1.1.0", "elm/file": "1.0.1",
"elm/virtual-dom": "1.0.2", "elm/virtual-dom": "1.0.2"
"rtfeldman/elm-hex": "1.0.0"
} }
}, },
"test-dependencies": { "test-dependencies": {

56
elm.nix
View File

@@ -1,56 +0,0 @@
{ 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
View File

@@ -1,61 +0,0 @@
{
"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
}

View File

@@ -1,23 +0,0 @@
{
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;
}
);
}

View File

@@ -1,21 +0,0 @@
<!DOCTYPE HTML>
<html>
<head>
<link rel="stylesheet" href="/static/css/style.css">
<script src="/static/js/elm.js"></script>
<script src="/static/js/notifications.js"></script>
<script src="/static/js/storage.js"></script>
<script src="/static/js/markdown.js"></script>
<script src="https://cdnjs.cloudflare.com/ajax/libs/marked/0.5.2/marked.min.js"></script>
<meta name="viewport" content="width=device-width, initial-scale=1">
<meta charset="UTF-8">
</head>
<body>
<script>
app = Elm.Main.init({ "flags" : { "token" : null } });
setupNotificationPorts(app);
setupStorage(app);
setupMarkdownPorts(app);
</script>
</body>
</html>

Binary file not shown.

Binary file not shown.

Before

Width:  |  Height:  |  Size: 518 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 14 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 20 KiB

View File

@@ -1,24 +1,16 @@
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.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.Login exposing (..) import Scylla.Login exposing (..)
import Scylla.Api exposing (..) import Scylla.Api exposing (..)
import Scylla.Model exposing (..) 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.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
@@ -26,8 +18,6 @@ import Json.Encode
import Json.Decode import Json.Decode
import Time exposing (every) import Time exposing (every)
import Html exposing (div, text) import Html exposing (div, text)
import File exposing (File)
import File.Select as Select
import Http import Http
import Dict import Dict
import Task import Task
@@ -35,41 +25,42 @@ import Task
syncTimeout = 10000 syncTimeout = 10000
typingTimeout = 2000 typingTimeout = 2000
init : () -> Url -> Nav.Key -> (Model, Cmd Msg) type alias Flags =
init _ url key = { token : Maybe String
}
init : Flags -> Url -> Nav.Key -> (Model, Cmd Msg)
init flags url key =
let let
model = model =
{ key = key { key = key
, route = Maybe.withDefault Unknown <| parse Scylla.Route.route url , route = Maybe.withDefault Unknown <| parse Scylla.Route.route url
, token = Nothing , token = flags.token
, loginUsername = "" , loginUsername = ""
, loginPassword = "" , loginPassword = ""
, apiUrl = "https://matrix.org" , apiUrl = "https://matrix.org"
, nextBatch = "" , sync =
, accountData = { events = Just [] } { nextBatch = ""
, rooms = Nothing
, presence = Nothing
, accountData = Nothing
}
, errors = [] , errors = []
, roomText = Dict.empty , roomText = Dict.empty
, sending = Dict.empty
, transactionId = 0 , transactionId = 0
, connected = True , userData = Dict.empty
, searchText = ""
, rooms = emptyOpenRooms
} }
cmd = getStoreValuePort "scylla.loginInfo" cmd = case flags.token of
Just _ -> Cmd.none
Nothing -> getStoreValuePort "scylla.loginInfo"
in in
(model, cmd) (model, cmd)
view : Model -> Browser.Document Msg view : Model -> Browser.Document Msg
view m = view m =
let { title = "Scylla"
notificationString = getTotalNotificationCountString m.rooms , body = viewFull m
titleString = case notificationString of }
Nothing -> "Scylla"
Just s -> s ++ " Scylla"
in
{ title = titleString
, body = viewFull m
}
update : Msg -> Model -> (Model, Cmd Msg) update : Msg -> Model -> (Model, Cmd Msg)
update msg model = case msg of update msg model = case msg of
@@ -85,107 +76,15 @@ 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 -> (model, Cmd.none) ReceiveUserData s r -> updateUserData model s r
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 r -> (model, Cmd.none)
ReceiveCompletedReadMarker r -> (model, Cmd.none) ReceiveCompletedReadMarker r -> (model, Cmd.none)
ReceiveCompletedTypingIndicator r -> (model, Cmd.none) ReceiveCompletedTypingIndicator r -> (model, Cmd.none)
ReceiveStoreData d -> updateStoreData model d ReceiveStoreData d -> updateStoreData model d
TypingTick _ -> updateTypingTick model TypingTick _ -> updateTypingTick model
History r -> updateHistory model r
ReceiveHistoryResponse r hr -> updateHistoryResponse model r hr
SendImages rid -> (model, Select.files [ "image/jpeg", "image/png", "image/gif" ] <| ImagesSelected rid)
SendFiles rid -> (model, Select.files [ "application/*" ] <| FilesSelected rid)
ImagesSelected rid f fs -> updateUploadSelected model rid f fs (ImageUploadComplete rid)
FilesSelected rid f fs -> updateUploadSelected model rid f fs (FileUploadComplete rid)
ImageUploadComplete rid mime ur -> updateImageUploadComplete model rid mime ur
FileUploadComplete rid mime ur -> updateFileUploadComplete model rid mime ur
SendImageResponse _ -> (model, Cmd.none)
SendFileResponse _ -> (model, Cmd.none)
ReceiveMarkdown md -> updateMarkdown model md
DismissError i -> updateDismissError model i
AttemptReconnect -> ({ model | connected = True }, firstSync model.apiUrl (Maybe.withDefault "" model.token))
UpdateSearchText s -> ({ model | searchText = s }, Cmd.none)
requestScrollCmd : Cmd Msg
requestScrollCmd = Task.attempt ViewportAfterMessage (Browser.Dom.getViewportOf "messages-wrapper")
updateSendRoomTextResponse : Model -> Int -> Result Http.Error String -> (Model, Cmd Msg)
updateSendRoomTextResponse m t r =
let
updateFunction newId msg = case msg of
Just (rid, { body, id }) -> Just (rid, { body = body, id = Just newId })
Nothing -> Nothing
in
case r of
Ok s -> ({ m | sending = Dict.update t (updateFunction s) m.sending }, Cmd.none)
Err e -> ({ m | sending = Dict.remove t m.sending }, Cmd.none)
updateDismissError : Model -> Int -> (Model, Cmd Msg)
updateDismissError m i = ({ m | errors = (List.take i m.errors) ++ (List.drop (i+1) m.errors)}, Cmd.none)
updateMarkdown : Model -> MarkdownResponse -> (Model, Cmd Msg)
updateMarkdown m { roomId, text, markdown } =
let
storeValueCmd = setStoreValuePort ("scylla.loginInfo", Json.Encode.string
<| encodeLoginInfo
<| LoginInfo (Maybe.withDefault "" m.token) m.apiUrl m.loginUsername (m.transactionId + 1))
sendMessageCmd = sendMarkdownMessage m.apiUrl (Maybe.withDefault "" m.token) (m.transactionId + 1) roomId text markdown
newModel =
{ m | transactionId = m.transactionId + 1
, sending = Dict.insert (m.transactionId + 1) (roomId, { body = TextMessage text, id = Nothing }) m.sending
}
in
(newModel, Cmd.batch [ storeValueCmd, sendMessageCmd, requestScrollCmd ])
updateFileUploadComplete : Model -> RoomId -> File -> (Result Http.Error String) -> (Model, Cmd Msg)
updateFileUploadComplete m rid mime ur =
let
command = case ur of
Ok u -> sendFileMessage m.apiUrl (Maybe.withDefault "" m.token) (m.transactionId + 1) rid mime u
_ -> Cmd.none
newErrors = case ur of
Err e -> [ "Error uploading file. Please check your internet connection and try again." ]
_ -> []
in
({ m | errors = newErrors ++ m.errors, transactionId = m.transactionId + 1}, command)
updateImageUploadComplete : Model -> RoomId -> File -> (Result Http.Error String) -> (Model, Cmd Msg)
updateImageUploadComplete m rid mime ur =
let
command = case ur of
Ok u -> sendImageMessage m.apiUrl (Maybe.withDefault "" m.token) (m.transactionId + 1) rid mime u
_ -> Cmd.none
newErrors = case ur of
Err e -> [ "Error uploading image. Please check your internet connection and try again." ]
_ -> []
in
({ m | transactionId = m.transactionId + 1}, command)
updateUploadSelected : Model -> RoomId -> File -> List File -> (File -> Result Http.Error String -> Msg) -> (Model, Cmd Msg)
updateUploadSelected m rid f fs msg =
let
uploadCmds = List.map (uploadMediaFile m.apiUrl (Maybe.withDefault "" m.token) msg) (f::fs)
in
(m, Cmd.batch uploadCmds)
updateHistoryResponse : Model -> RoomId -> Result Http.Error HistoryResponse -> (Model, Cmd Msg)
updateHistoryResponse m r hr =
case hr of
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)
updateHistory : Model -> RoomId -> (Model, Cmd Msg)
updateHistory m r =
let
prevBatch = Dict.get r m.rooms
|> Maybe.andThen (.prevHistoryBatch)
command = case prevBatch of
Just pv -> getHistory m.apiUrl (Maybe.withDefault "" m.token) r pv
Nothing -> Cmd.none
in
(m, command)
updateChangeRoomText : Model -> RoomId -> String -> (Model, Cmd Msg) updateChangeRoomText : Model -> RoomId -> String -> (Model, Cmd Msg)
updateChangeRoomText m roomId text = updateChangeRoomText m roomId text =
@@ -235,10 +134,9 @@ updateChangeRoute : Model -> Route -> (Model, Cmd Msg)
updateChangeRoute m r = updateChangeRoute m r =
let let
joinedRoom = case r of joinedRoom = case r of
Room rid -> Dict.get rid m.rooms Room rid -> Maybe.andThen (Dict.get rid) <| Maybe.andThen .join <| m.sync.rooms
_ -> Nothing _ -> Nothing
lastMessage = Maybe.map .messages joinedRoom lastMessage = Maybe.andThen (findLastEvent (((==) "m.room.message") << .type_)) <| Maybe.andThen .events <| Maybe.andThen .timeline 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
@@ -249,11 +147,16 @@ updateViewportAfterMessage : Model -> Result Browser.Dom.Error Viewport -> (Mode
updateViewportAfterMessage m vr = updateViewportAfterMessage m vr =
let let
cmd vp = if vp.scene.height - (vp.viewport.y + vp.viewport.height ) < 100 cmd vp = if vp.scene.height - (vp.viewport.y + vp.viewport.height ) < 100
then Task.attempt ViewportChangeComplete <| setViewportOf "messages-wrapper" vp.viewport.x vp.scene.height then Task.attempt ViewportChangeComplete <| setViewportOf "events-wrapper" vp.viewport.x vp.scene.height
else Cmd.none else Cmd.none
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, userData m.apiUrl (Maybe.withDefault "" m.token) s)
updateSendRoomText : Model -> RoomId -> (Model, Cmd Msg) updateSendRoomText : Model -> RoomId -> (Model, Cmd Msg)
updateSendRoomText m r = updateSendRoomText m r =
let let
@@ -263,11 +166,14 @@ updateSendRoomText m r =
combinedCmd = case message of combinedCmd = case message of
Nothing -> Cmd.none Nothing -> Cmd.none
Just s -> Cmd.batch Just s -> Cmd.batch
[ requestMarkdownPort { roomId = r, text = s } [ sendTextMessage m.apiUrl token m.transactionId r s
, sendTypingIndicator m.apiUrl token r m.loginUsername False typingTimeout , sendTypingIndicator m.apiUrl token r m.loginUsername False typingTimeout
, setStoreValuePort ("scylla.loginInfo", Json.Encode.string
<| encodeLoginInfo
<| LoginInfo (Maybe.withDefault "" m.token) m.apiUrl m.loginUsername (m.transactionId + 1))
] ]
in in
({ m | roomText = Dict.insert r "" m.roomText }, combinedCmd) ({ m | roomText = Dict.insert r "" m.roomText, transactionId = m.transactionId + 1 }, combinedCmd)
updateTryUrl : Model -> Browser.UrlRequest -> (Model, Cmd Msg) updateTryUrl : Model -> Browser.UrlRequest -> (Model, Cmd Msg)
updateTryUrl m ur = case ur of updateTryUrl m ur = case ur of
@@ -279,31 +185,31 @@ updateLoginResponse model a r = case r of
Ok lr -> ( { model | token = Just lr.accessToken, loginUsername = lr.userId, apiUrl = a }, Cmd.batch Ok lr -> ( { model | token = Just lr.accessToken, loginUsername = lr.userId, apiUrl = a }, Cmd.batch
[ firstSync model.apiUrl lr.accessToken [ firstSync model.apiUrl lr.accessToken
, Nav.pushUrl model.key <| Url.Builder.absolute [] [] , Nav.pushUrl model.key <| Url.Builder.absolute [] []
, setStoreValuePort ("scylla.loginInfo", Json.Encode.string , setStoreValuePort ("scylla.loginInfo", Json.Encode.string <| encodeLoginInfo (lr.accessToken, model.apiUrl, lr.userId))
<| encodeLoginInfo
<| LoginInfo lr.accessToken model.apiUrl lr.userId model.transactionId)
] ) ] )
Err e -> ({ model | errors = "Failed to log in. Are your username and password correct?"::model.errors }, Cmd.none) Err e -> (model, Cmd.none)
updateSyncResponse : Model -> Result Http.Error SyncResponse -> Bool -> (Model, Cmd Msg) updateSyncResponse : Model -> Result Http.Error SyncResponse -> Bool -> (Model, Cmd Msg)
updateSyncResponse model r notify = updateSyncResponse model r notify =
let let
token = Maybe.withDefault "" model.token token = Maybe.withDefault "" model.token
nextBatch = Result.withDefault model.nextBatch nextBatch = Result.withDefault model.sync.nextBatch
<| Result.map .nextBatch r <| Result.map .nextBatch r
syncCmd = sync model.apiUrl token nextBatch syncCmd = sync nextBatch model.apiUrl token
notification sr = newUsers sr = List.filter (\s -> not <| Dict.member s model.userData) <| roomsUsers sr
getPushRuleset model.accountData newUserCmd sr = Cmd.batch
|> Maybe.map (\rs -> getNotificationEvents rs sr) <| List.map (userData model.apiUrl
|> Maybe.withDefault [] <| Maybe.withDefault "" model.token)
|> findFirstBy <| newUsers sr
(\(s, e) -> e.originServerTs) notification sr = findFirstBy
(\(s, e) -> e.sender /= model.loginUsername) (\(s, e) -> e.originServerTs)
(\(s, e) -> e.sender /= model.loginUsername)
<| notificationEvents 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 = roomLocalDisplayName model s e.sender { name = displayName model e.sender
, text = getText e , text = notificationText e
, room = s , room = s
}) <| notification sr }) <| notification sr
else Cmd.none else Cmd.none
@@ -311,7 +217,6 @@ 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)
@@ -321,30 +226,20 @@ updateSyncResponse model r notify =
setScrollCmd sr = if List.isEmpty setScrollCmd sr = if List.isEmpty
<| roomMessages sr <| roomMessages sr
then Cmd.none then Cmd.none
else requestScrollCmd else Task.attempt ViewportAfterMessage (Browser.Dom.getViewportOf "events-wrapper")
setReadReceiptCmd sr = case (room, List.head <| List.reverse <| roomMessages sr) of setReadReceiptCmd sr = case (room, List.head <| List.reverse <| roomMessages sr) of
(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
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 -> (newModel sr Ok sr -> ({ model | sync = mergeSyncResponse model.sync sr }, Cmd.batch
, Cmd.batch
[ syncCmd [ syncCmd
, newUserCmd sr
, notificationCmd sr , notificationCmd sr
, setScrollCmd sr , setScrollCmd sr
, setReadReceiptCmd sr , setReadReceiptCmd sr
]) ])
_ -> ({ model | connected = False }, Cmd.none) _ -> (model, syncCmd)
subscriptions : Model -> Sub Msg subscriptions : Model -> Sub Msg
subscriptions m = subscriptions m =
@@ -360,7 +255,6 @@ subscriptions m =
[ onNotificationClickPort OpenRoom [ onNotificationClickPort OpenRoom
, receiveStoreValuePort ReceiveStoreData , receiveStoreValuePort ReceiveStoreData
, typingTimer , typingTimer
, receiveMarkdownPort ReceiveMarkdown
] ]
onUrlRequest : Browser.UrlRequest -> Msg onUrlRequest : Browser.UrlRequest -> Msg

View File

@@ -6,7 +6,9 @@ type alias ApiToken = String
type alias ApiUrl = String type alias ApiUrl = String
basicHeaders : List Header basicHeaders : List Header
basicHeaders = [] basicHeaders =
[ header "Content-Type" "application/json"
]
authenticatedHeaders : ApiToken -> List Header authenticatedHeaders : ApiToken -> List Header
authenticatedHeaders token = authenticatedHeaders token =

View File

@@ -2,28 +2,11 @@ module Scylla.Http exposing (..)
import Scylla.Model exposing (..) import Scylla.Model exposing (..)
import Scylla.Api exposing (..) import Scylla.Api exposing (..)
import Scylla.Route exposing (RoomId) import Scylla.Route exposing (RoomId)
import Scylla.Sync exposing (syncResponseDecoder, historyResponseDecoder) import Scylla.Sync exposing (syncResponseDecoder)
import Scylla.Login exposing (loginResponseDecoder, Username, Password) import Scylla.Login exposing (loginResponseDecoder, Username, Password)
import Scylla.UserData exposing (userDataDecoder, UserData) import Scylla.UserData exposing (userDataDecoder, UserData)
import Url.Builder import Json.Encode exposing (object, string, int, bool)
import Json.Encode exposing (object, string, int, bool, list) import Http exposing (request, emptyBody, jsonBody, expectJson, expectWhatever)
import Json.Decode as Decode exposing (field)
import Http exposing (request, emptyBody, jsonBody, fileBody, expectJson, expectWhatever)
import File exposing (File, name, mime)
import Url.Builder as Builder
import Json.Decode
firstSyncFilter : Json.Decode.Value
firstSyncFilter = object
[ ("room", object
[ ("state", object
[ ("types", list string [ "m.room.name", "m.room.member" ])
])
])
]
firstSyncFilterString : String
firstSyncFilterString = Json.Encode.encode 0 firstSyncFilter
fullClientUrl : ApiUrl -> ApiUrl fullClientUrl : ApiUrl -> ApiUrl
fullClientUrl s = s ++ "/_matrix/client/r0" fullClientUrl s = s ++ "/_matrix/client/r0"
@@ -36,15 +19,15 @@ firstSync : ApiUrl -> ApiToken -> Cmd Msg
firstSync apiUrl token = request firstSync apiUrl token = request
{ method = "GET" { method = "GET"
, headers = authenticatedHeaders token , headers = authenticatedHeaders token
, url = Url.Builder.crossOrigin (fullClientUrl apiUrl) [ "sync" ] [ Url.Builder.string "filter" firstSyncFilterString ] , url = (fullClientUrl apiUrl) ++ "/sync"
, body = emptyBody , body = emptyBody
, expect = expectJson ReceiveFirstSyncResponse syncResponseDecoder , expect = expectJson ReceiveFirstSyncResponse syncResponseDecoder
, timeout = Nothing , timeout = Nothing
, tracker = Nothing , tracker = Nothing
} }
sync : ApiUrl -> ApiToken -> String -> Cmd Msg sync : String -> ApiUrl -> ApiToken -> Cmd Msg
sync apiUrl token nextBatch = request sync nextBatch apiUrl token = request
{ method = "GET" { method = "GET"
, headers = authenticatedHeaders token , headers = authenticatedHeaders token
, url = (fullClientUrl apiUrl) ++ "/sync" ++ "?since=" ++ (nextBatch) ++ "&timeout=10000" , url = (fullClientUrl apiUrl) ++ "/sync" ++ "?since=" ++ (nextBatch) ++ "&timeout=10000"
@@ -54,72 +37,23 @@ sync apiUrl token nextBatch = request
, tracker = Nothing , tracker = Nothing
} }
uploadMediaFile : ApiUrl -> ApiToken -> (File -> Result Http.Error String -> Msg) -> File -> Cmd Msg sendTextMessage : ApiUrl -> ApiToken -> Int -> String -> String -> Cmd Msg
uploadMediaFile apiUrl token msg file = request sendTextMessage apiUrl token transactionId room message = request
{ method = "POST"
, headers = authenticatedHeaders token
, url = Builder.crossOrigin (fullMediaUrl apiUrl) [ "upload" ] [ Builder.string "filename" (name file) ]
, body = fileBody file
, expect = expectJson (msg file) <| Json.Decode.field "content_uri" Json.Decode.string
, timeout = Nothing
, tracker = Nothing
}
getHistory : ApiUrl -> ApiToken -> RoomId -> String -> Cmd Msg
getHistory apiUrl token room prevBatch = request
{ method = "GET"
, headers = authenticatedHeaders token
, url = (fullClientUrl apiUrl) ++ "/rooms/" ++ room ++ "/messages" ++ "?from=" ++ prevBatch ++ "&dir=" ++ "b"
, body = emptyBody
, expect = expectJson (ReceiveHistoryResponse room) historyResponseDecoder
, timeout = Nothing
, tracker = Nothing
}
sendMessage : ApiUrl -> ApiToken -> Int -> RoomId -> (Result Http.Error String -> Msg) -> List (String, Json.Encode.Value) -> Cmd Msg
sendMessage apiUrl token transactionId room msg contents = request
{ method = "PUT" { method = "PUT"
, headers = authenticatedHeaders token , headers = authenticatedHeaders token
, url = (fullClientUrl apiUrl) , url = (fullClientUrl apiUrl)
++ "/rooms/" ++ room ++ "/rooms/" ++ room
++ "/send/" ++ "m.room.message" ++ "/send/" ++ "m.room.message"
++ "/" ++ (String.fromInt transactionId) ++ "/" ++ (String.fromInt transactionId)
, body = jsonBody <| object contents , body = jsonBody <| object
, expect = expectJson msg (field "event_id" Decode.string) [ ("msgtype", string "m.text")
, ("body", string message)
]
, expect = expectWhatever SendRoomTextResponse
, timeout = Nothing , timeout = Nothing
, tracker = Nothing , tracker = Nothing
} }
sendMarkdownMessage : ApiUrl -> ApiToken -> Int -> RoomId -> String -> String -> Cmd Msg
sendMarkdownMessage apiUrl token transactionId room message md = sendMessage apiUrl token transactionId room (SendRoomTextResponse transactionId)
[ ("msgtype", string "m.text")
, ("body", string message)
, ("formatted_body", string md)
, ("format", string "org.matrix.custom.html")
]
sendTextMessage : ApiUrl -> ApiToken -> Int -> RoomId -> String -> Cmd Msg
sendTextMessage apiUrl token transactionId room message = sendMessage apiUrl token transactionId room (SendRoomTextResponse transactionId)
[ ("msgtype", string "m.text")
, ("body", string message)
]
sendImageMessage : ApiUrl -> ApiToken -> Int -> RoomId -> File -> String -> Cmd Msg
sendImageMessage apiUrl token transactionId room file message = sendMessage apiUrl token transactionId room SendImageResponse
[ ("msgtype", string "m.image")
, ("body", string <| name file)
, ("url", string message)
, ("info", object [ ("mimetype", string <| mime file) ])
]
sendFileMessage : ApiUrl -> ApiToken -> Int -> RoomId -> File -> String -> Cmd Msg
sendFileMessage apiUrl token transactionId room file message = sendMessage apiUrl token transactionId room SendFileResponse
[ ("msgtype", string "m.file")
, ("body", string <| name file)
, ("url", string message)
, ("info", object [ ("mimetype", string <| mime file) ])
]
login : ApiUrl -> Username -> Password -> Cmd Msg login : ApiUrl -> Username -> Password -> Cmd Msg
login apiUrl username password = request login apiUrl username password = request
{ method = "POST" { method = "POST"
@@ -138,8 +72,8 @@ login apiUrl username password = request
, tracker = Nothing , tracker = Nothing
} }
getUserData : ApiUrl -> ApiToken -> Username -> Cmd Msg userData : ApiUrl -> ApiToken -> Username -> Cmd Msg
getUserData apiUrl token username = request userData 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 +83,7 @@ getUserData apiUrl token username = request
, tracker = Nothing , tracker = Nothing
} }
setReadMarkers : ApiUrl -> ApiToken -> RoomId -> String -> Maybe String -> Cmd Msg setReadMarkers : ApiUrl -> ApiToken -> String -> RoomId -> Maybe String -> Cmd Msg
setReadMarkers apiUrl token roomId fullyRead readReceipt = setReadMarkers apiUrl token roomId fullyRead readReceipt =
let let
readReciptFields = case readReceipt of readReciptFields = case readReceipt of
@@ -176,14 +110,3 @@ sendTypingIndicator apiUrl token room user isTyping timeout = request
, timeout = Nothing , timeout = Nothing
, tracker = Nothing , tracker = Nothing
} }
setRoomAccountData : ApiUrl -> ApiToken -> Username -> RoomId -> String -> Decode.Value -> Msg -> Cmd Msg
setRoomAccountData apiUrl token user roomId key value msg = request
{ method = "PUT"
, headers = authenticatedHeaders token
, url = (fullClientUrl apiUrl) ++ "/user/" ++ user ++ "/rooms/" ++ roomId ++ "/account_data/" ++ key
, body = jsonBody value
, expect = expectWhatever (\_ -> msg)
, timeout = Nothing
, tracker = Nothing
}

View File

@@ -1,39 +0,0 @@
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,15 +0,0 @@
port module Scylla.Markdown exposing (..)
type alias MarkdownRequest =
{ roomId : String
, text : String
}
type alias MarkdownResponse =
{ roomId : String
, text : String
, markdown : String
}
port requestMarkdownPort : MarkdownRequest -> Cmd msg
port receiveMarkdownPort : (MarkdownResponse -> msg) -> Sub msg

View File

@@ -1,48 +0,0 @@
module Scylla.Messages exposing (..)
import Scylla.Sync.Events exposing (RoomEvent, MessageEvent, toMessageEvent)
import Scylla.Login exposing (Username)
import Scylla.Route exposing (RoomId)
import Scylla.Room exposing (RoomData)
import Dict exposing (Dict)
type SendingMessageBody = TextMessage String
type alias SendingMessage =
{ body : SendingMessageBody
, id : Maybe String
}
type Message
= Sending SendingMessage
| Received MessageEvent
getUsername : Username -> Message -> Username
getUsername u msg = case msg of
Sending _ -> u
Received re -> re.sender
groupMessages : Username -> List Message -> List (Username, List Message)
groupMessages du xs =
let
initialState = (Nothing, [], [])
appendNamed mu ms msl = case mu of
Just u -> msl ++ [(u, ms)]
Nothing -> msl
foldFunction msg (pu, ms, msl) =
let
nu = Just <| getUsername du msg
in
if pu == nu then (pu, ms ++ [msg], msl) else (nu, [msg], appendNamed pu ms msl)
(fmu, fms, fmsl) = List.foldl foldFunction initialState xs
in
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,25 +1,16 @@
module Scylla.Model exposing (..) module Scylla.Model exposing (..)
import Scylla.Api exposing (..) import Scylla.Api exposing (..)
import Scylla.Room exposing (getLocalDisplayName) import Scylla.Sync exposing (SyncResponse, JoinedRoom, senderName)
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.Storage exposing (..) import Scylla.Storage exposing (..)
import Scylla.Markdown exposing (..)
import Browser.Navigation as Nav import Browser.Navigation as Nav
import Browser.Dom exposing (Viewport) import Browser.Dom exposing (Viewport)
import Url.Builder import Url.Builder
import Dict exposing (Dict) import Dict exposing (Dict)
import Time exposing (Posix) import Time exposing (Posix)
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)
@@ -31,15 +22,11 @@ type alias Model =
, loginUsername : Username , loginUsername : Username
, loginPassword : Password , loginPassword : Password
, apiUrl : ApiUrl , apiUrl : ApiUrl
, accountData : AccountData , sync : SyncResponse
, nextBatch : String
, errors : List String , errors : List String
, roomText : Dict RoomId String , roomText : Dict String String
, sending : Dict Int (RoomId, SendingMessage)
, transactionId : Int , transactionId : Int
, connected : Bool , userData : Dict Username UserData
, searchText : String
, rooms : OpenRooms
} }
type Msg = type Msg =
@@ -52,7 +39,7 @@ type Msg =
| ChangeRoute Route -- URL changes | ChangeRoute Route -- URL changes
| ChangeRoomText String String -- Change to a room's input text | ChangeRoomText String String -- Change to a room's input text
| SendRoomText String -- Sends a message typed into a given room's input | SendRoomText String -- Sends a message typed into a given room's input
| SendRoomTextResponse Int (Result Http.Error String) -- A send message response finished | SendRoomTextResponse (Result Http.Error ()) -- A send message response finished
| ViewportAfterMessage (Result Browser.Dom.Error Viewport) -- A message has been received, try scroll (maybe) | ViewportAfterMessage (Result Browser.Dom.Error Viewport) -- A message has been received, try scroll (maybe)
| ViewportChangeComplete (Result Browser.Dom.Error ()) -- We're done changing the viewport. | ViewportChangeComplete (Result Browser.Dom.Error ()) -- We're done changing the viewport.
| ReceiveFirstSyncResponse (Result Http.Error SyncResponse) -- HTTP, Sync has finished | ReceiveFirstSyncResponse (Result Http.Error SyncResponse) -- HTTP, Sync has finished
@@ -61,22 +48,11 @@ 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 Decode.Value -- We are send back a value on request from localStorage. | ReceiveStoreData Json.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
| ReceiveHistoryResponse RoomId (Result Http.Error HistoryResponse) -- HTTP, receive history displayName : Model -> Username -> String
| SendImages RoomId -- Image selection triggered displayName m s = Maybe.withDefault (senderName s) <| Maybe.andThen .displayName <| Dict.get s m.userData
| SendFiles RoomId -- File selection triggered
| ImagesSelected RoomId File (List File) -- Images to send selected
| FilesSelected RoomId File (List File) -- Files to send selected
| ImageUploadComplete RoomId File (Result Http.Error String) -- Image has been uploaded
| FileUploadComplete RoomId File (Result Http.Error String) -- File has been uploaded
| SendImageResponse (Result Http.Error String) -- Server responded to image
| SendFileResponse (Result Http.Error String) -- Server responded to file
| ReceiveMarkdown MarkdownResponse -- Markdown was rendered
| DismissError Int -- User dismisses error
| AttemptReconnect -- User wants to reconnect to server
| UpdateSearchText String -- Change search text in room list
roomUrl : String -> String roomUrl : String -> String
roomUrl s = Url.Builder.absolute [ "room", s ] [] roomUrl s = Url.Builder.absolute [ "room", s ] []
@@ -84,13 +60,14 @@ roomUrl s = Url.Builder.absolute [ "room", s ] []
loginUrl : String loginUrl : String
loginUrl = Url.Builder.absolute [ "login" ] [] loginUrl = Url.Builder.absolute [ "login" ] []
currentRoom : Model -> Maybe JoinedRoom
currentRoom m =
let
roomDict = Maybe.withDefault Dict.empty <| Maybe.andThen .join <| m.sync.rooms
in
Maybe.andThen (\s -> Dict.get s roomDict) <| 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,9 +1,5 @@
port module Scylla.Notification exposing (..) port module Scylla.Notification exposing (..)
import Scylla.Sync exposing (SyncResponse, joinedRoomsTimelineEvents) import Json.Decode
import Scylla.Sync.Events exposing (RoomEvent, MessageEvent, toMessageEvent)
import Scylla.Sync.Push exposing (Ruleset, getEventNotification)
import Json.Decode as Decode exposing (string, field)
import Dict
type alias Notification = type alias Notification =
{ name : String { name : String
@@ -13,20 +9,3 @@ 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
getText : MessageEvent -> String
getText re = case (Decode.decodeValue (field "msgtype" string) re.content) of
Ok "m.text" -> Result.withDefault "" <| (Decode.decodeValue (field "body" string) re.content)
_ -> ""
getNotificationEvents : Ruleset -> SyncResponse -> List (String, MessageEvent)
getNotificationEvents rs s = s.rooms
|> Maybe.andThen .join
|> Maybe.map (Dict.map (\k v -> v.timeline
|> Maybe.andThen .events
|> Maybe.map (List.filter <| getEventNotification rs k)
|> Maybe.map (List.filterMap <| toMessageEvent)
|> Maybe.withDefault []))
|> Maybe.withDefault Dict.empty
|> Dict.toList
|> List.concatMap (\(k, vs) -> List.map (\v -> (k, v)) vs)

View File

@@ -1,187 +0,0 @@
module Scylla.Room exposing (..)
import Scylla.Route exposing (RoomId)
import Scylla.Sync exposing (SyncResponse)
import Scylla.Login exposing (Username)
import Scylla.UserData exposing (getSenderName)
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 =
{ roomState : RoomState
, messages : List (MessageEvent)
, accountData : AccountData
, ephemeral : Ephemeral
, unreadNotifications : UnreadNotificationCounts
, prevHistoryBatch : Maybe String
, text : String
}
type alias OpenRooms = Dict RoomId RoomData
emptyOpenRooms : OpenRooms
emptyOpenRooms = Dict.empty
emptyRoomData : RoomData
emptyRoomData =
{ roomState = Dict.empty
, messages = []
, accountData = { events = Just [] }
, ephemeral = { events = Just [] }
, unreadNotifications =
{ highlightCount = Just 0
, notificationCount = Just 0
}
, prevHistoryBatch = Nothing
, text = ""
}
changeRoomStateEvent : StateEvent -> RoomState -> RoomState
changeRoomStateEvent se = Dict.insert (se.type_, se.stateKey) se.content
changeRoomStateEvents : List StateEvent -> RoomState -> RoomState
changeRoomStateEvents es rs = List.foldr (changeRoomStateEvent) rs es
changeRoomState : JoinedRoom -> RoomState -> RoomState
changeRoomState jr rs =
let
stateDiff = jr.state
|> Maybe.andThen .events
|> Maybe.withDefault []
timelineDiff = jr.timeline
|> Maybe.andThen .events
|> Maybe.map (List.filterMap toStateEvent)
|> Maybe.withDefault []
in
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

@@ -1,17 +1,238 @@
module Scylla.Sync exposing (..) module Scylla.Sync exposing (..)
import Scylla.Api exposing (..) import Scylla.Api exposing (..)
import Scylla.Notification exposing (..)
import Scylla.Login exposing (Username) import Scylla.Login exposing (Username)
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 =
{ avatarUrl : Maybe String
, displayname : Maybe String
, membership : String
, isDirect : Maybe Bool
-- , thirdPartyInvite : Invite
, unsigned : Maybe UnsignedData
}
eventContentDecoder : Decoder EventContent
eventContentDecoder =
Decode.succeed EventContent
|> maybeDecode "avatar_url" string
|> maybeDecode "displayname" string
|> required "membership" string
|> maybeDecode "is_direct" bool
-- |> required "third_party_invite" inviteDecoder
|> maybeDecode "unsigned" unsignedDataDecoder
-- 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
@@ -37,53 +258,185 @@ presenceDecoder =
Decode.succeed Presence Decode.succeed Presence
|> maybeDecode "events" (list eventDecoder) |> maybeDecode "events" (list eventDecoder)
-- Room History Responses -- Business Logic
type alias HistoryResponse = uniqueByRecursive : (a -> comparable) -> List a -> Set comparable -> List a
{ start : String uniqueByRecursive f l s = case l of
, end : String x::tail -> if Set.member (f x) s
, chunk : List RoomEvent then uniqueByRecursive f tail s
} else x::uniqueByRecursive f tail (Set.insert (f x) s)
[] -> []
historyResponseDecoder : Decoder HistoryResponse uniqueBy : (a -> comparable) -> List a -> List a
historyResponseDecoder = uniqueBy f l = uniqueByRecursive f l Set.empty
Decode.succeed HistoryResponse
|> required "start" string findFirst : (a -> Bool) -> List a -> Maybe a
|> required "end" string findFirst cond l = case l of
|> required "chunk" (list roomEventDecoder) 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
-- Business Logic: Helper Functions
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: Events -- Business Logic: Merging
allRoomDictTimelineEvents : Dict String { a | timeline : Maybe Timeline } -> List RoomEvent mergeMaybe : (a -> a -> a) -> Maybe a -> Maybe a -> Maybe a
allRoomDictTimelineEvents dict = List.concatMap (Maybe.withDefault [] << .events) mergeMaybe f l r = case (l, r) of
<| List.filterMap .timeline (Just v1, Just v2) -> Just <| f v1 v2
<| Dict.values dict (Just v, Nothing) -> Just v
(Nothing, Just v) -> Just v
_ -> Nothing
allTimelineEventIds : SyncResponse -> List String mergeEvents : List Event -> List Event -> List Event
allTimelineEventIds s = List.map getEventId <| allTimelineEvents s mergeEvents l1 l2 = l1 ++ l2
allTimelineEvents : SyncResponse -> List RoomEvent mergeStateEvents : List StateEvent -> List StateEvent -> List StateEvent
allTimelineEvents s = 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 let
eventsFor f = Maybe.withDefault [] inOne = Dict.insert
<| Maybe.map allRoomDictTimelineEvents inBoth k v1 v2 = Dict.insert k (f v1 v2)
<| Maybe.andThen f s.rooms
joinedEvents = eventsFor .join
leftEvents = eventsFor .leave
in in
leftEvents ++ joinedEvents Dict.merge inOne inBoth inOne d1 d2 (Dict.empty)
joinedRoomsTimelineEvents : SyncResponse -> Dict String (List RoomEvent) mergeState : State -> State -> State
joinedRoomsTimelineEvents s = 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 t2.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
}
-- Business Logic: Names
senderName : String -> String
senderName s =
let
colonIndex = Maybe.withDefault -1
<| List.head
<| String.indexes ":" s
in
String.slice 1 colonIndex s
roomName : JoinedRoom -> Maybe String
roomName jr =
let
nameEvent = Maybe.andThen (findLastEvent (((==) "m.room.name") << .type_))
<< Maybe.andThen .events
name c = Result.toMaybe <| Decode.decodeValue (field "name" string) c
maybeStateEvent = nameEvent jr.state
maybeTimelineEvent = nameEvent jr.timeline
realEventContent = case maybeTimelineEvent of
Just te -> Just te.content
_ -> Maybe.map .content maybeStateEvent
in
Maybe.andThen name realEventContent
-- Business Logic: Event Extraction
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)
_ -> ""
notificationEvents : SyncResponse -> List (String, RoomEvent)
notificationEvents s =
let
applyPair k = List.map (\v -> (k, v))
in
List.sortBy (\(k, v) -> v.originServerTs)
<| Dict.foldl (\k v a -> a ++ applyPair k v) []
<| joinedRoomsEvents s
joinedRoomsEvents : SyncResponse -> Dict String (List RoomEvent)
joinedRoomsEvents s =
Maybe.withDefault Dict.empty Maybe.withDefault Dict.empty
<| 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
-- Business Logic: Users -- Business Logic: User Extraction
allUsers : SyncResponse -> List Username roomTypingUsers : JoinedRoom -> List Username
allUsers s = uniqueBy (\u -> u) <| List.map getSender <| allTimelineEvents s 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
roomsUsers : SyncResponse -> List Username
roomsUsers s =
let
users dict =
List.map .sender
<| (List.concatMap <| Maybe.withDefault [] << .events)
<| (List.filterMap .timeline)
<| Dict.values dict
usersFor f = Maybe.withDefault [] <| Maybe.map users <| Maybe.andThen f s.rooms
joinedUsers = usersFor .join
leftUsers = usersFor .leave
in
uniqueBy (\u -> u) <| leftUsers ++ joinedUsers

View File

@@ -1,54 +0,0 @@
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

@@ -1,9 +0,0 @@
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

View File

@@ -1,149 +0,0 @@
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_ }

View File

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

View File

@@ -1,109 +0,0 @@
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,8 +1,6 @@
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
@@ -14,13 +12,3 @@ 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,31 +1,19 @@
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.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.Util
import Svg import Svg
import Svg.Attributes import Svg.Attributes
import Url.Builder import Url.Builder
import Json.Decode as Decode 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, table, td, tr, img)
import Html.Attributes exposing (type_, placeholder, value, href, class, style, src, id, rows, controls, src, classList) import Html.Attributes exposing (type_, value, href, class, style, src, id)
import Html.Events exposing (onInput, onClick, preventDefaultOn) import Html.Events exposing (onInput, onClick, on)
import Html.Lazy exposing (lazy5) import Dict
import Dict exposing (Dict)
import Tuple
maybeHtml : List (Maybe (Html Msg)) -> List (Html Msg)
maybeHtml = List.filterMap (\i -> i)
contentRepositoryDownloadUrl : ApiUrl -> String -> String contentRepositoryDownloadUrl : ApiUrl -> String -> String
contentRepositoryDownloadUrl apiUrl s = contentRepositoryDownloadUrl apiUrl s =
@@ -47,8 +35,9 @@ stringColor s =
viewFull : Model -> List (Html Msg) viewFull : Model -> List (Html Msg)
viewFull model = viewFull model =
let let
room r = Dict.get r model.rooms room r = Maybe.map (\jr -> (r, jr))
|> Maybe.map (\rd -> (r, rd)) <| Maybe.andThen (Dict.get r)
<| Maybe.andThen .join model.sync.rooms
core = case model.route of core = case model.route of
Login -> loginView model Login -> loginView model
Base -> baseView model Nothing Base -> baseView model Nothing
@@ -59,108 +48,74 @@ viewFull model =
[ errorList ] ++ [ core ] [ errorList ] ++ [ core ]
errorsView : List String -> Html Msg errorsView : List String -> Html Msg
errorsView = div [ class "errors-wrapper" ] << List.indexedMap errorView errorsView = div [] << List.map errorView
errorView : Int -> String -> Html Msg errorView : String -> Html Msg
errorView i s = div [ class "error-wrapper", onClick <| DismissError i ] [ iconView "alert-triangle", text s ] errorView s = div [] [ text s ]
baseView : Model -> Maybe (RoomId, RoomData) -> Html Msg baseView : Model -> Maybe (String, JoinedRoom) -> Html Msg
baseView m rd = baseView m jr =
let let
roomView = Maybe.map (\(id, r) -> joinedRoomView m id r) rd roomView = case jr of
reconnect = reconnectView m Just (id, r) -> joinedRoomView m id r
Nothing -> div [] []
in in
div [ class "base-wrapper" ] <| maybeHtml div [ class "base-wrapper" ]
[ Just <| roomListView m [ roomListView m
, roomView , roomView
, reconnect ]
]
reconnectView : Model -> Maybe (Html Msg)
reconnectView m = if m.connected
then Nothing
else Just <| div [ class "reconnect-wrapper", onClick AttemptReconnect ] [ iconView "zap", text "Disconnected. Click here to reconnect." ]
roomListView : Model -> Html Msg roomListView : Model -> Html Msg
roomListView m = roomListView m =
let let
groups = roomGroups rooms = Maybe.withDefault (Dict.empty) <| Maybe.andThen .join <| m.sync.rooms
<| Dict.toList m.rooms roomList = div [ class "rooms-list" ] <| Dict.values <| Dict.map roomListElementView rooms
homeserverList = div [ class "homeservers-list" ]
<| List.map (\(k, v) -> homeserverView m k v)
<| Dict.toList groups
in in
div [ class "rooms-wrapper" ] div [ class "rooms-wrapper" ]
[ h2 [] [ text "Rooms" ] [ h2 [] [ text "Rooms" ]
, input , roomList
[ class "room-search"
, type_ "text"
, placeholder "Search chats..."
, onInput UpdateSearchText
, value m.searchText
] []
, homeserverList
] ]
roomGroups : List (String, RoomData) -> Dict String (List (String, RoomData)) roomListElementView : String -> JoinedRoom -> Html Msg
roomGroups jrs = groupBy (getHomeserver << Tuple.first) jrs roomListElementView s jr =
homeserverView : Model -> String -> List (String, RoomData) -> Html Msg
homeserverView m hs rs =
let let
roomList = div [ class "rooms-list" ] name = Maybe.withDefault "<No Name>" <| roomName jr
<| List.map (\(rid, r) -> roomListElementView m rid r)
<| List.sortBy (\(rid, r) -> getRoomName m.accountData rid r) rs
in in
div [ class "homeserver-wrapper" ] [ h3 [] [ text hs ], roomList ] div [ class "room-link-wrapper" ]
[ a [ href <| roomUrl s ] [ text name ]
roomListElementView : Model -> RoomId -> RoomData -> Html Msg , roomNotificationCountView jr.unreadNotifications
roomListElementView m rid rd =
let
name = getRoomName m.accountData rid rd
isVisible = m.searchText == "" || (String.contains (String.toLower m.searchText) <| String.toLower name)
isCurrentRoom = case currentRoomId m of
Nothing -> False
Just cr -> cr == rid
in
div [ classList
[ ("room-link-wrapper", True)
, ("active", isCurrentRoom)
, ("hidden", not isVisible)
]
] ]
<| roomNotificationCountView rd.unreadNotifications ++
[ a [ href <| roomUrl rid ] [ text name ] ]
roomNotificationCountView : UnreadNotificationCounts -> List (Html Msg) roomNotificationCountView : Maybe UnreadNotificationCounts -> Html Msg
roomNotificationCountView ns = roomNotificationCountView ns =
let let
wrap b = span spanNumber = case Maybe.andThen .notificationCount ns of
[ classList Nothing -> ""
[ ("notification-count", True) Just 0 -> ""
, ("bright", b) Just i -> String.fromInt i
] spanSuffix = case Maybe.andThen .highlightCount ns of
] Nothing -> ""
getCount f = Maybe.withDefault 0 << f Just 0 -> ""
Just i -> "!"
in in
case (getCount .notificationCount ns, getCount .highlightCount ns) of span [ class "notification-count" ] [ text (spanNumber ++ spanSuffix) ]
(0, 0) -> []
(i, 0) -> [ wrap False [ iconView "bell", text <| String.fromInt i ] ]
(i, j) -> [ wrap True [ iconView "alert-circle", text <| String.fromInt i ] ]
loginView : Model -> Html Msg loginView : Model -> Html Msg
loginView m = div [ class "login-wrapper" ] loginView m = div [ class "login-wrapper" ]
[ h2 [] [ text "Log In" ] [ h2 [] [ text "Log In" ]
, input [ type_ "text", placeholder "Username", value m.loginUsername, onInput ChangeLoginUsername] [] , input [ type_ "text", value m.loginUsername, onInput ChangeLoginUsername] []
, input [ type_ "password", placeholder "Password", value m.loginPassword, onInput ChangeLoginPassword ] [] , input [ type_ "password", value m.loginPassword, onInput ChangeLoginPassword ] []
, input [ type_ "text", placeholder "Homeserver URL", value m.apiUrl, onInput ChangeApiUrl ] [] , input [ type_ "text", value m.apiUrl, onInput ChangeApiUrl ] []
, button [ onClick AttemptLogin ] [ text "Log In" ] , button [ onClick AttemptLogin ] [ text "Log In" ]
] ]
joinedRoomView : Model -> RoomId -> RoomData -> Html Msg joinedRoomView : Model -> String -> JoinedRoom -> Html Msg
joinedRoomView m roomId rd = joinedRoomView m roomId jr =
let let
typing = List.map (getLocalDisplayName rd) <| getRoomTypingUsers rd events = Maybe.withDefault [] <| Maybe.andThen .events jr.timeline
renderedEvents = List.filterMap (eventView m) events
eventWrapper = eventWrapperView m renderedEvents
typing = List.map (displayName m) <| roomTypingUsers jr
typingText = String.join ", " typing typingText = String.join ", " typing
typingSuffix = case List.length typing of typingSuffix = case List.length typing of
0 -> "" 0 -> ""
@@ -168,45 +123,28 @@ joinedRoomView m roomId rd =
_ -> " are typing..." _ -> " are typing..."
typingWrapper = div [ class "typing-wrapper" ] [ text <| typingText ++ typingSuffix ] typingWrapper = div [ class "typing-wrapper" ] [ text <| typingText ++ typingSuffix ]
messageInput = div [ class "message-wrapper" ] messageInput = div [ class "message-wrapper" ]
[ textarea [ input
[ rows 1 [ type_ "text"
, onInput <| ChangeRoomText roomId , onInput <| ChangeRoomText roomId
, onEnterKey <| SendRoomText roomId , onEnterKey <| SendRoomText roomId
, placeholder "Type your message here..."
, value <| Maybe.withDefault "" <| Dict.get roomId m.roomText , value <| Maybe.withDefault "" <| Dict.get roomId m.roomText
] [] ] []
, button [ onClick <| SendFiles roomId ] [ iconView "file" ]
, button [ onClick <| SendImages roomId ] [ iconView "image" ]
, button [ onClick <| SendRoomText roomId ] [ iconView "send" ] , button [ onClick <| SendRoomText roomId ] [ iconView "send" ]
] ]
in in
div [ class "room-wrapper" ] div [ class "room-wrapper" ]
[ h2 [] [ text <| getRoomName m.accountData roomId rd ] [ h2 [] [ text <| Maybe.withDefault "<No Name>" <| roomName jr ]
, lazy5 lazyMessagesView roomId rd m.apiUrl m.loginUsername m.sending , eventWrapper
, messageInput
, typingWrapper , typingWrapper
, messageInput
] ]
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
eventDecoder = Decode.map2 (\l r -> (l, r)) (Decode.field "keyCode" Decode.int) (Decode.field "shiftKey" Decode.bool) isEnter code = if code == 13 then Decode.succeed msg else Decode.fail "Not ENTER"
msgFor (code, shift) = if code == 13 && not shift then Decode.succeed msg else Decode.fail "Not ENTER"
pairTrue v = (v, True)
decoder = Decode.map pairTrue <| Decode.andThen msgFor <| eventDecoder
in in
preventDefaultOn "keydown" decoder on "keydown" (Decode.andThen isEnter <| Decode.field "keyCode" Decode.int)
iconView : String -> Html Msg iconView : String -> Html Msg
iconView name = iconView name =
@@ -217,105 +155,50 @@ 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 : RoomId -> List (Html Msg) -> Html Msg eventWrapperView : Model -> List (Html Msg) -> Html Msg
messagesWrapperView rid es = div [ class "messages-wrapper", id "messages-wrapper" ] eventWrapperView m es = div [ class "events-wrapper", id "events-wrapper" ] [ table [ class "events-table" ] es ]
[ a [ class "history-link", onClick <| History rid ] [ text "Load older messages" ]
, table [ class "messages-table" ] es
]
senderView : RoomData -> Username -> Html Msg eventView : Model -> RoomEvent -> Maybe (Html Msg)
senderView rd s = eventView m re =
span [ style "color" <| stringColor s, class "sender-wrapper" ] [ text <| getLocalDisplayName rd s ]
userMessagesView : RoomData -> ApiUrl -> (Username, List Message) -> Html Msg
userMessagesView rd apiUrl (u, ms) =
let let
wrap h = div [ class "message" ] [ h ] viewFunction = case re.type_ of
in "m.room.message" -> Just messageView
tr [] _ -> Nothing
[ td [] [ senderView rd u ] createRow mhtml = tr []
, td [] <| List.map wrap <| List.filterMap (messageView rd apiUrl) ms [ td [] [ eventSenderView m re.sender ]
, td [] [ mhtml ]
] ]
in
Maybe.map createRow
<| Maybe.andThen (\f -> f m re) viewFunction
messageView : RoomData -> ApiUrl -> Message -> Maybe (Html Msg) eventSenderView : Model -> Username -> Html Msg
messageView rd apiUrl msg = case msg of eventSenderView m s =
Sending t -> Just <| sendingMessageView t span [ style "background-color" <| stringColor s, class "sender-wrapper" ] [ text <| displayName m s ]
Received re -> roomEventView rd apiUrl re
sendingMessageView : SendingMessage -> Html Msg messageView : Model -> RoomEvent -> Maybe (Html Msg)
sendingMessageView msg = case msg.body of messageView m re =
TextMessage t -> span [ class "sending"] [ text t ]
roomEventView : RoomData -> ApiUrl -> MessageEvent -> Maybe (Html Msg)
roomEventView rd apiUrl re =
let let
msgtype = Decode.decodeValue (Decode.field "msgtype" Decode.string) re.content msgtype = Decode.decodeValue (Decode.field "msgtype" Decode.string) re.content
in in
case msgtype of case msgtype of
Ok "m.text" -> roomEventTextView re Ok "m.text" -> messageTextView m re
Ok "m.notice" -> roomEventNoticeView re Ok "m.image" -> messageImageView m re
Ok "m.emote" -> roomEventEmoteView rd re
Ok "m.image" -> roomEventImageView apiUrl re
Ok "m.file" -> roomEventFileView apiUrl re
Ok "m.video" -> roomEventVideoView apiUrl re
_ -> Nothing _ -> Nothing
roomEventFormattedContent : MessageEvent -> Maybe (List (Html Msg)) messageTextView : Model -> RoomEvent -> Maybe (Html Msg)
roomEventFormattedContent re = Maybe.map Html.Parser.Util.toVirtualDom messageTextView m re =
<| Maybe.andThen (Result.toMaybe << Html.Parser.run )
<| Result.toMaybe
<| Decode.decodeValue (Decode.field "formatted_body" Decode.string) re.content
roomEventContent : (List (Html Msg) -> Html Msg) -> MessageEvent -> Maybe (Html Msg)
roomEventContent f re =
let let
body = Decode.decodeValue (Decode.field "body" Decode.string) re.content body = Decode.decodeValue (Decode.field "body" Decode.string) re.content
customHtml = roomEventFormattedContent re wrap mtext = span [] [ text mtext ]
in in
case customHtml of Maybe.map wrap <| Result.toMaybe body
Just c -> Just <| f c
Nothing -> Maybe.map (f << List.singleton << text) <| Result.toMaybe body
roomEventEmoteView : RoomData -> MessageEvent -> Maybe (Html Msg) messageImageView : Model -> RoomEvent -> Maybe (Html Msg)
roomEventEmoteView rd re = messageImageView m 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 apiUrl) <| Maybe.map (contentRepositoryDownloadUrl m.apiUrl)
<| Result.toMaybe body <| Result.toMaybe body
roomEventFileView : ApiUrl -> MessageEvent -> Maybe (Html Msg)
roomEventFileView apiUrl re =
let
decoder = Decode.map2 (\l r -> (l, r)) (Decode.field "url" Decode.string) (Decode.field "body" Decode.string)
fileData = Decode.decodeValue decoder re.content
in
Maybe.map (\(url, name) -> a [ href url, class "file-wrapper" ] [ iconView "file", text name ])
<| Maybe.map (\(url, name) -> (contentRepositoryDownloadUrl apiUrl url, name))
<| Result.toMaybe fileData
roomEventVideoView : ApiUrl -> MessageEvent -> Maybe (Html Msg)
roomEventVideoView apiUrl re =
let
decoder = Decode.map2 (\l r -> (l, r))
(Decode.field "url" Decode.string)
(Decode.field "info" <| Decode.field "mimetype" Decode.string)
videoData = Decode.decodeValue decoder re.content
in
Maybe.map (\(url, t) -> video [ controls True ] [ source [ src url, type_ t ] [] ])
<| Maybe.map (\(url, type_) -> (contentRepositoryDownloadUrl apiUrl url, type_))
<| Result.toMaybe videoData

View File

@@ -1,9 +0,0 @@
function setupMarkdownPorts(app) {
app.ports.requestMarkdownPort.subscribe(function(data) {
app.ports.receiveMarkdownPort.send({
"roomId" : data.roomId,
"text" : data.text,
"markdown" : marked(data.text)
});
})
}

View File

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

View File

@@ -1,12 +0,0 @@
@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,7 +1,15 @@
@import url('https://fonts.googleapis.com/css?family=Open+Sans|Source+Code+Pro'); @import url('https://fonts.googleapis.com/css?family=Open+Sans');
@import 'mixins'; $primary-color: #53C0FA;
@import 'variables'; $primary-color-highlight: #4298C7;
@import 'components'; $primary-color-light: #9FDBFB;
$active-input-color: white;
$background-color: #fafafa;
$background-color-dark: darken($background-color, 4%);
$transition-duration: .125s;
$inactive-input-color: darken($active-input-color, 3%);
$active-input-border-color: $primary-color;
$inactive-input-border-color: darken($inactive-input-color, 10%);
html, body { html, body {
height: 100vh; height: 100vh;
@@ -9,22 +17,28 @@ html, body {
body { body {
font-family: 'Open Sans', sans-serif; font-family: 'Open Sans', sans-serif;
margin: 0; margin: 0px;
background-color: $background-color; background-color: $background-color;
font-size: .7em; font-size: 12px;
color: white;
} }
input, textarea { @mixin input-common {
padding: 5px;
border-radius: 3px;
outline: none;
transition: background-color $transition-duration;
}
input {
@include input-common(); @include input-common();
overflow-x: hidden;
background-color: $inactive-input-color; background-color: $inactive-input-color;
color: white; color: black;
border: none; border: .5px solid $inactive-input-border-color;
padding: .5em;
&:focus { &:focus {
background-color: $active-input-color; background-color: $active-input-color;
border-color: $active-input-border-color;
} }
} }
@@ -40,7 +54,6 @@ button {
} }
} }
a { a {
text-decoration: none; text-decoration: none;
color: $primary-color; color: $primary-color;
@@ -50,44 +63,9 @@ a {
} }
} }
h1, h2, h3, h4, h5, h6 { h2 {
margin: 0; margin: 0px;
margin-bottom: .5em; margin-bottom: 3px;
}
/*
* Errors
*/
div.errors-wrapper {
position: fixed;
pointer-events: none;
top: 0;
bottom: 0;
left: 0;
right: 0;
overflow: hidden;
}
div.error-wrapper {
pointer-events: auto;
width: 40%;
padding: .5em;
background-color: $error-color;
border: .1em solid $error-color-dark;
color: white;
margin: auto;
margin-top: .85em;
margin-bottom: .85em;
font-size: 1em;
align-items: center;
overflow-x: hidden;
white-space: nowrap;
text-overflow: ellipsis;
.feather-icon {
margin-right: .85em;
}
} }
/* /*
@@ -96,12 +74,12 @@ div.error-wrapper {
div.login-wrapper { div.login-wrapper {
display: flex; display: flex;
flex-direction: column; flex-direction: column;
max-width: 30%; max-width: 300px;
margin: auto; margin: auto;
margin-top: 1.5em; margin-top: 20px;
input, button { input, button {
margin: .3em; margin: 3px;
} }
} }
@@ -111,86 +89,27 @@ div.login-wrapper {
div.base-wrapper { div.base-wrapper {
display: flex; display: flex;
height: 100%; height: 100%;
> div {
padding: 5px;
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%;
min-width: 20em;
padding: .85em;
box-sizing: border-box;
border-right: .1em solid $background-color-dark;
.room-search {
padding: .5em;
width: 100%;
box-sizing: border-box;
}
} }
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;
align-items: center; padding: 0px;
.feather-icon { span, a {
height: 1.2em; margin-right: 5px;
}
span.notification-count {
color: $alert-color;
margin-right: .5em;
display: flex;
align-items: center;
&.bright {
color: $alert-color-bright;
}
}
a {
color: lightgrey;
white-space: nowrap;
overflow: hidden;
text-overflow: ellipsis;
}
&:hover a {
color: $primary-color;
transition: color $transition-duration;
}
&.active {
border-left: solid .2em $primary-color;
}
&.hidden {
display: none;
}
}
div.reconnect-wrapper {
position: fixed;
bottom: 1.5em;
left: 1.5em;
padding: .85em;
display: flex;
align-items: center;
background-color: $inactive-input-color;
border-radius: $border-radius;
.feather-icon {
margin-right: .85em;
} }
} }
@@ -198,156 +117,87 @@ 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: .85em;
} }
div.typing-wrapper { div.typing-wrapper {
padding: .5em; padding: 5px;
height: 1em;
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 {
flex-grow: 12; flex-grow: 9;
margin: .3em; margin: 3px;
} }
button { button {
margin: .3em; flex-grow: 1;
height: 3em; margin: 3px;
width: 3em;
transition: color $transition-duration;
background-color: $background-color;
color: $primary-color;
&:hover {
color: $primary-color-light;
}
} }
} }
div.messages-wrapper { div.events-wrapper {
overflow-y: scroll; overflow-y: scroll;
flex-grow: 1; flex-grow: 1;
a.history-link {
display: block;
width: 100%;
text-align: center;
box-sizing: border-box;
padding: .5em;
}
} }
table.messages-table { table.events-table {
border-collapse: collapse; border-collapse: collapse;
width: 100%; width: 100%;
table-layout: fixed; table-layout: fixed;
td { td {
padding: .5em; padding: 5px;
vertical-align: top; vertical-align: top;
} }
img { img {
max-width: 90%; max-width: 90%;
max-height: 30em; max-height: 400px;
margin-top: .85em;
margin-bottom: .85em;
box-shadow: 0 0 .5em rgba(0, 0, 0, .5);
}
.sending {
color: grey;
}
video {
max-width: 90%;
max-height: 30em;
} }
td:nth-child(1) { td:nth-child(1) {
width: 10%; width: 10%;
max-width: 100px;
white-space: nowrap; white-space: nowrap;
} }
}
div.message { tr:nth-child(2n) {
p {
margin: 0;
}
blockquote {
margin: 0 0 0 0;
padding-left: .5em;
border-left: .4em solid $primary-color;
}
code {
font-family: Iosevka, "Source Code Pro", monospace,
}
pre code {
width: 100%;
overflow: auto;
display: block;
box-sizing: border-box;
padding: .85em;
background-color: $background-color-dark; background-color: $background-color-dark;
border-radius: $border-radius;
box-shadow: $inset-shadow;
} }
} }
span.sender-wrapper { span.sender-wrapper {
border-radius: $border-radius; border-radius: 2px;
padding-left: .5em; padding-left: 5px;
padding-right: .5em; padding-right: 5px;
display: inline-block; display: inline-block;
box-sizing: border-box; box-sizing: border-box;
text-align: right; text-align: center;
font-weight: 800;
width: 100%; width: 100%;
text-overflow: ellipsis; text-overflow: ellipsis;
overflow: hidden; overflow: hidden;
vertical-align: bottom; /* Fix for overflow changing element height */ vertical-align: bottom; /* Fix for overflow changing element height */
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
*/ */
.feather-icon { .feather-icon {
vertical-align: middle;
stroke: currentColor; stroke: currentColor;
stroke-width: 2; stroke-width: 2;
stroke-linecap: round; stroke-linecap: round;
stroke-linejoin: round; stroke-linejoin: round;
fill: none; fill: none;
height: 1.5em; height: 20px;
width: 1.5em; width: 20px;
} }

View File

@@ -1,26 +0,0 @@
// 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;