Matrix-Programs/Scylla
1
0
Fork 0
Code Issues 9 Pull Requests Releases Wiki Activity

Compare commits

base: Matrix-Programs:720e6db3345d753eb67d71e7068f6fb8edadf9bc
Branches Tags
Matrix-Programs:master
..
compare: Matrix-Programs:2c99d10075f3e9ce7bd35c7d388411e10ad83348
Branches Tags
Matrix-Programs:master

No commits in common. "720e6db3345d753eb67d71e7068f6fb8edadf9bc" and "2c99d10075f3e9ce7bd35c7d388411e10ad83348" have entirely different histories.
720e6db334 ... 2c99d10075

6 changed files with 27 additions and 157 deletions
Show Stats Expand all files Collapse all files

69
src/Main.elm
View File

@ -1,6 +1,5 @@
import Browser exposing (application, UrlRequest(..))
import Browser.Navigation as Nav
import Browser.Dom exposing (Viewport, setViewportOf)
import Scylla.Sync exposing (..)
import Scylla.Login exposing (..)
import Scylla.Model exposing (..)
@ -15,7 +14,6 @@ import Url.Builder
import Html exposing (div, text)
import Http
import Dict
import Task
type alias Flags =
{ token : Maybe String
@ -62,9 +60,7 @@ update msg model = case msg of
AttemptLogin -> (model, Scylla.Http.login model.apiUrl model.loginUsername model.loginPassword) -- TODO
TryUrl urlRequest -> updateTryUrl model urlRequest
OpenRoom s -> (model, Nav.pushUrl model.key <| roomUrl s)
ChangeRoute r -> updateChangeRoute model r
ViewportAfterMessage v -> updateViewportAfterMessage model v
ViewportChangeComplete _ -> (model, Cmd.none)
ChangeRoute r -> ({ model | route = r }, Cmd.none)
ReceiveLoginResponse r -> updateLoginResponse model r
ReceiveFirstSyncResponse r -> updateSyncResponse model r False
ReceiveSyncResponse r -> updateSyncResponse model r True
@ -72,29 +68,6 @@ update msg model = case msg of
ChangeRoomText r t -> ({ model | roomText = Dict.insert r t model.roomText}, Cmd.none)
SendRoomText r -> updateSendRoomText model r
SendRoomTextResponse r -> (model, Cmd.none)
ReceiveCompletedReadMarker r -> (model, Cmd.none)
updateChangeRoute : Model -> Route -> (Model, Cmd Msg)
updateChangeRoute m r =
let
joinedRoom = case r of
Room rid -> Maybe.andThen (Dict.get rid) <| Maybe.andThen .join <| m.sync.rooms
_ -> Nothing
lastMessage = Maybe.andThen (findLastEvent (((==) "m.room.message") << .type_)) <| Maybe.andThen .events <| Maybe.andThen .timeline joinedRoom
readMarkerCmd = case (r, lastMessage) of
(Room rid, Just re) -> setReadMarkers m.apiUrl (Maybe.withDefault "" m.token) rid re.eventId <| Just re.eventId
_ -> Cmd.none
in
({ m | route = r }, readMarkerCmd)
updateViewportAfterMessage : Model -> Result Browser.Dom.Error Viewport -> (Model, Cmd Msg)
updateViewportAfterMessage m vr =
let
cmd vp = if vp.scene.height - (vp.viewport.y + vp.viewport.height ) < 100
then Task.attempt ViewportChangeComplete <| setViewportOf "events-wrapper" vp.viewport.x vp.scene.height
else Cmd.none
in
(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
@ -133,7 +106,7 @@ updateSyncResponse model r notify =
<| Result.map .nextBatch r
syncCmd = sync nextBatch model.apiUrl token
newUsers sr = List.filter (\s -> not <| Dict.member s model.userData) <| roomsUsers sr
newUserCmd sr = Cmd.batch
newUserCommands sr = Cmd.batch
<| List.map (userData model.apiUrl
<| Maybe.withDefault "" model.token)
<| newUsers sr
@ -141,39 +114,19 @@ updateSyncResponse model r notify =
(\(s, e) -> e.originServerTs)
(\(s, e) -> e.sender /= model.loginUsername)
<| notificationEvents sr
notificationCmd sr = if notify
then Maybe.withDefault Cmd.none
<| Maybe.map (\(s, e) -> sendNotificationPort
{ name = displayName model e.sender
, text = notificationText e
, room = s
}) <| notification sr
else Cmd.none
room = currentRoomId model
roomMessages sr = case room of
Just rid -> List.filter (((==) "m.room.message") << .type_)
<| Maybe.withDefault []
<| Maybe.andThen .events
<| Maybe.andThen .timeline
<| Maybe.andThen (Dict.get rid)
<| Maybe.andThen .join
<| sr.rooms
Nothing -> []
setScrollCmd sr = if List.isEmpty
<| roomMessages sr
then Cmd.none
else Task.attempt ViewportAfterMessage (Browser.Dom.getViewportOf "events-wrapper")
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
_ -> Cmd.none
notificationCommand sr = Maybe.withDefault Cmd.none
<| Maybe.map (\(s, e) -> sendNotificationPort
{ name = displayName model e.sender
, text = notificationText e
, room = s
})
<| notification sr
in
case r of
Ok sr -> ({ model | sync = mergeSyncResponse model.sync sr }, Cmd.batch
[ syncCmd
, newUserCmd sr
, notificationCmd sr
, setScrollCmd sr
, setReadReceiptCmd sr
, newUserCommands sr
, if notify then notificationCommand sr else Cmd.none
])
_ -> (model, syncCmd)

35
src/Scylla/Http.elm
View File

@ -1,25 +1,21 @@
module Scylla.Http exposing (..)
import Scylla.Model exposing (..)
import Scylla.Api exposing (..)
import Scylla.Route exposing (RoomId)
import Scylla.Sync exposing (syncResponseDecoder)
import Scylla.Login exposing (loginResponseDecoder, Username, Password)
import Scylla.UserData exposing (userDataDecoder, UserData)
import Json.Encode exposing (object, string, int)
import Http exposing (request, emptyBody, jsonBody, expectJson, expectWhatever)
fullClientUrl : ApiUrl -> ApiUrl
fullClientUrl s = s ++ "/_matrix/client/r0"
fullMediaUrl : ApiUrl -> ApiUrl
fullMediaUrl s = s ++ "/_matrix/media/r0"
fullUrl : ApiUrl -> ApiUrl
fullUrl s = s ++ "/_matrix/client/r0"
-- Http Requests
firstSync : ApiUrl -> ApiToken -> Cmd Msg
firstSync apiUrl token = request
{ method = "GET"
, headers = authenticatedHeaders token
, url = (fullClientUrl apiUrl) ++ "/sync"
, url = (fullUrl apiUrl) ++ "/sync"
, body = emptyBody
, expect = expectJson ReceiveFirstSyncResponse syncResponseDecoder
, timeout = Nothing
@ -30,7 +26,7 @@ sync : String -> ApiUrl -> ApiToken -> Cmd Msg
sync nextBatch apiUrl token = request
{ method = "GET"
, headers = authenticatedHeaders token
, url = (fullClientUrl apiUrl) ++ "/sync" ++ "?since=" ++ (nextBatch) ++ "&timeout=10000"
, url = (fullUrl apiUrl) ++ "/sync" ++ "?since=" ++ (nextBatch) ++ "&timeout=10000"
, body = emptyBody
, expect = expectJson ReceiveSyncResponse syncResponseDecoder
, timeout = Nothing
@ -41,7 +37,7 @@ sendTextMessage : ApiUrl -> ApiToken -> Int -> String -> String -> Cmd Msg
sendTextMessage apiUrl token transactionId room message = request
{ method = "PUT"
, headers = authenticatedHeaders token
, url = (fullClientUrl apiUrl)
, url = (fullUrl apiUrl)
++ "/rooms/" ++ room
++ "/send/" ++ "m.room.message"
++ "/" ++ (String.fromInt transactionId)
@ -58,7 +54,7 @@ login : ApiUrl -> Username -> Password -> Cmd Msg
login apiUrl username password = request
{ method = "POST"
, headers = basicHeaders
, url = (fullClientUrl apiUrl) ++ "/login"
, url = (fullUrl apiUrl) ++ "/login"
, body = jsonBody <| object
[ ("type", string "m.login.password")
, ("identifier", object
@ -76,26 +72,9 @@ userData : ApiUrl -> ApiToken -> Username -> Cmd Msg
userData apiUrl token username = request
{ method = "GET"
, headers = authenticatedHeaders token
, url = (fullClientUrl apiUrl) ++ "/profile/" ++ username
, url = (fullUrl apiUrl) ++ "/profile/" ++ username
, body = emptyBody
, expect = expectJson (ReceiveUserData username) userDataDecoder
, timeout = Nothing
, tracker = Nothing
}
setReadMarkers : ApiUrl -> ApiToken -> String -> RoomId -> Maybe String -> Cmd Msg
setReadMarkers apiUrl token roomId fullyRead readReceipt =
let
readReciptFields = case readReceipt of
Just s -> [ ("m.read", string s) ]
_ -> []
in
request
{ method = "POST"
, headers = authenticatedHeaders token
, url = (fullClientUrl apiUrl) ++ "/rooms/" ++ roomId ++ "/read_markers"
, body = jsonBody <| object <| [ ("m.fully_read", string fullyRead) ] ++ readReciptFields
, expect = expectWhatever ReceiveCompletedReadMarker
, timeout = Nothing
, tracker = Nothing
}

18
src/Scylla/Model.elm
View File

@ -3,9 +3,8 @@ import Scylla.Api exposing (..)
import Scylla.Sync exposing (SyncResponse, JoinedRoom, senderName)
import Scylla.Login exposing (LoginResponse, Username, Password)
import Scylla.UserData exposing (UserData)
import Scylla.Route exposing (Route(..), RoomId)
import Scylla.Route exposing (Route)
import Browser.Navigation as Nav
import Browser.Dom exposing (Viewport)
import Url.Builder
import Dict exposing (Dict)
import Browser
@ -37,13 +36,10 @@ type Msg =
| ChangeRoomText String String -- Change to a room's input text
| SendRoomText String -- Sends a message typed into a given room's input
| SendRoomTextResponse (Result Http.Error ()) -- A send message response finished
| 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.
| ReceiveFirstSyncResponse (Result Http.Error SyncResponse) -- HTTP, Sync has finished
| ReceiveSyncResponse (Result Http.Error SyncResponse) -- HTTP, Sync has finished
| ReceiveLoginResponse (Result Http.Error LoginResponse) -- HTTP, Login has finished
| ReceiveUserData Username (Result Http.Error UserData)
| ReceiveCompletedReadMarker (Result Http.Error ())
displayName : Model -> Username -> String
displayName m s = Maybe.withDefault (senderName s) <| Maybe.andThen .displayName <| Dict.get s m.userData
@ -53,15 +49,3 @@ roomUrl s = Url.Builder.absolute [ "room", s ] []
loginUrl : String
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 m = case m.route of
Room r -> Just r
_ -> Nothing

13
src/Scylla/Sync.elm
View File

@ -387,16 +387,11 @@ senderName 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
state = jr.state
nameEvent = findLastEvent (((==) "m.room.name") << .type_)
name e = Result.toMaybe <| Decode.decodeValue (field "name" string) e.content
in
Maybe.andThen name realEventContent
Maybe.andThen name <| Maybe.andThen nameEvent <| Maybe.andThen .events <| state
-- Business Logic: Event Extraction
notificationText : RoomEvent -> String

38
src/Scylla/Views.elm
View File

@ -4,27 +4,15 @@ import Scylla.Sync exposing (..)
import Scylla.Route exposing (..)
import Scylla.Fnv as Fnv
import Scylla.Login exposing (Username)
import Scylla.Http exposing (fullMediaUrl)
import Scylla.Api exposing (ApiUrl)
import Svg
import Svg.Attributes
import Url.Builder
import Json.Decode as Decode
import Html exposing (Html, Attribute, div, input, text, button, div, span, a, h2, table, td, tr, img)
import Html.Attributes exposing (type_, value, href, class, style, src, id)
import Html.Events exposing (onInput, onClick, on)
import Html exposing (Html, div, input, text, button, div, span, a, h2, table, td, tr)
import Html.Attributes exposing (type_, value, href, class, style)
import Html.Events exposing (onInput, onClick)
import Dict
contentRepositoryDownloadUrl : ApiUrl -> String -> String
contentRepositoryDownloadUrl apiUrl s =
let
lastIndex = Maybe.withDefault 6 <| List.head <| List.reverse <| String.indexes "/" s
authority = String.slice 6 lastIndex s
content = String.dropLeft (lastIndex + 1) s
in
(fullMediaUrl apiUrl) ++ "/download/" ++ authority ++ "/" ++ content
stringColor : String -> String
stringColor s =
let
@ -126,7 +114,6 @@ joinedRoomView m roomId jr =
[ input
[ type_ "text"
, onInput <| ChangeRoomText roomId
, onEnterKey <| SendRoomText roomId
, value <| Maybe.withDefault "" <| Dict.get roomId m.roomText
] []
, button [ onClick <| SendRoomText roomId ] [ iconView "send" ]
@ -139,13 +126,6 @@ joinedRoomView m roomId jr =
, messageInput
]
onEnterKey : Msg -> Attribute Msg
onEnterKey msg =
let
isEnter code = if code == 13 then Decode.succeed msg else Decode.fail "Not ENTER"
in
on "keydown" (Decode.andThen isEnter <| Decode.field "keyCode" Decode.int)
iconView : String -> Html Msg
iconView name =
let
@ -156,7 +136,7 @@ iconView name =
] [ Svg.use [ Svg.Attributes.xlinkHref (url ++ "#" ++ name) ] [] ]
eventWrapperView : Model -> List (Html Msg) -> Html Msg
eventWrapperView m es = div [ class "events-wrapper", id "events-wrapper" ] [ table [ class "events-table" ] es ]
eventWrapperView m es = div [ class "events-wrapper" ] [ table [ class "events-table" ] es ]
eventView : Model -> RoomEvent -> Maybe (Html Msg)
eventView m re =
@ -183,7 +163,6 @@ messageView m re =
in
case msgtype of
Ok "m.text" -> messageTextView m re
Ok "m.image" -> messageImageView m re
_ -> Nothing
messageTextView : Model -> RoomEvent -> Maybe (Html Msg)
@ -193,12 +172,3 @@ messageTextView m re =
wrap mtext = span [] [ text mtext ]
in
Maybe.map wrap <| Result.toMaybe body
messageImageView : Model -> RoomEvent -> Maybe (Html Msg)
messageImageView m re =
let
body = Decode.decodeValue (Decode.field "url" Decode.string) re.content
in
Maybe.map (\s -> img [ class "message-image", src s ] [])
<| Maybe.map (contentRepositoryDownloadUrl m.apiUrl)
<| Result.toMaybe body

11
static/scss/style.scss
View File

@ -19,7 +19,6 @@ body {
font-family: 'Open Sans', sans-serif;
margin: 0px;
background-color: $background-color;
font-size: 12px;
}
@mixin input-common {
@ -123,16 +122,11 @@ div.room-wrapper {
flex-direction: column;
}
div.typing-wrapper {
padding: 5px;
}
/*
* The message input and send button.
*/
div.message-wrapper {
display: flex;
flex-shrink: 0;
input {
flex-grow: 9;
@ -160,11 +154,6 @@ table.events-table {
vertical-align: top;
}
img {
max-width: 90%;
max-height: 400px;
}
td:nth-child(1) {
width: 10%;
max-width: 100px;