elm.json

@@ -9,7 +9,6 @@
             "NoRedInk/elm-json-decode-pipeline": "1.0.0",
             "elm/browser": "1.0.1",
             "elm/core": "1.0.2",
-            "elm/file": "1.0.1",
             "elm/html": "1.0.0",
             "elm/http": "2.0.0",
             "elm/json": "1.1.2",
@@ -19,6 +18,7 @@
         },
         "indirect": {
             "elm/bytes": "1.0.7",
+            "elm/file": "1.0.1",
             "elm/virtual-dom": "1.0.2"
         }
     },

src/Main.elm

@@ -18,8 +18,6 @@ import Json.Encode
 import Json.Decode
 import Time exposing (every)
 import Html exposing (div, text)
-import File exposing (File)
-import File.Select as Select
 import Http
 import Dict
 import Task
@@ -82,53 +80,11 @@ update msg model = case msg of
     TypingTick _ -> updateTypingTick model
     History r -> updateHistory model r
     ReceiveHistoryResponse r hr -> updateHistoryResponse model r hr
-    SendImages rid -> (model, Select.files [ "image/png" ] <| 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 ur -> updateImageUploadComplete model rid ur
-    FileUploadComplete rid ur -> updateFileUploadComplete model rid ur
-    SendImageResponse _ -> (model, Cmd.none)
-    SendFileResponse _ -> (model, Cmd.none)
-
-updateFileUploadComplete : Model -> RoomId -> (Result Http.Error String) -> (Model, Cmd Msg)
-updateFileUploadComplete m rid ur =
-    let
-        command = case ur of
-            Ok u -> sendFileMessage m.apiUrl (Maybe.withDefault "" m.token) m.transactionId rid u
-            _ -> Cmd.none
-    in
-        ({ m | transactionId = m.transactionId + 1}, command)
-
-updateImageUploadComplete : Model -> RoomId -> (Result Http.Error String) -> (Model, Cmd Msg)
-updateImageUploadComplete m rid ur =
-    let
-        command = case ur of
-            Ok u -> sendImageMessage m.apiUrl (Maybe.withDefault "" m.token) m.transactionId rid u
-            _ -> Cmd.none
-    in
-        ({ m | transactionId = m.transactionId + 1}, command)
-
-updateUploadSelected : Model -> RoomId -> File -> List 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 =
-    let
-        newUsersCmd h = Cmd.batch
-            <| List.map (userData m.apiUrl (Maybe.withDefault "" m.token))
-            <| newUsers m
-            <| uniqueBy (\s -> s)
-            <| List.map .sender
-            <| h.chunk
-    in
-        case hr of
-            Ok h -> ({ m | sync = appendHistoryResponse m.sync r h }, newUsersCmd h)
-            Err _ -> (m, Cmd.none)
+updateHistoryResponse m r hr = case hr of
+    Ok h -> ({ m | sync = appendHistoryResponse m.sync r h }, Cmd.none)
+    Err _ -> (m, Cmd.none)
 
 updateHistory : Model -> RoomId -> (Model, Cmd Msg)
 updateHistory m r =
@@ -256,11 +212,11 @@ updateSyncResponse model r notify =
         nextBatch = Result.withDefault model.sync.nextBatch
             <| Result.map .nextBatch r
         syncCmd = sync model.apiUrl token nextBatch
+        newUsers sr = List.filter (\s -> not <| Dict.member s model.userData) <| roomsUsers sr
         newUserCmd sr = Cmd.batch
             <| List.map (userData model.apiUrl
             <| Maybe.withDefault "" model.token)
-            <| newUsers model
-            <| allUsers sr
+            <| newUsers sr
         notification sr = findFirstBy
             (\(s, e) -> e.originServerTs)
             (\(s, e) -> e.sender /= model.loginUsername)

src/Scylla/Api.elm

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

src/Scylla/Http.elm

@@ -6,10 +6,7 @@ import Scylla.Sync exposing (syncResponseDecoder, historyResponseDecoder)
 import Scylla.Login exposing (loginResponseDecoder, Username, Password)
 import Scylla.UserData exposing (userDataDecoder, UserData)
 import Json.Encode exposing (object, string, int, bool)
-import Http exposing (request, emptyBody, jsonBody, fileBody, expectJson, expectWhatever)
-import File exposing (File, name, mime)
-import Url.Builder as Builder
-import Json.Decode
+import Http exposing (request, emptyBody, jsonBody, expectJson, expectWhatever)
 
 fullClientUrl : ApiUrl -> ApiUrl
 fullClientUrl s = s ++ "/_matrix/client/r0"
@@ -40,17 +37,6 @@ sync apiUrl token nextBatch = request
     , tracker = Nothing
     }
 
-uploadMediaFile : ApiUrl -> ApiToken -> (Result Http.Error String -> Msg) -> File -> Cmd Msg
-uploadMediaFile apiUrl token msg file = request
-    { method = "POST"
-    , headers = authenticatedHeaders token
-    , url = Builder.crossOrigin (fullMediaUrl apiUrl) [ "upload" ] [ Builder.string "filename" (name file) ]
-    , body = fileBody file
-    , expect = expectJson msg <| 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"
@@ -62,40 +48,23 @@ getHistory apiUrl token room prevBatch = request
     , tracker = Nothing
     }
 
-sendMessage : ApiUrl -> ApiToken -> Int -> RoomId -> (Result Http.Error () -> Msg) -> List (String, Json.Encode.Value) -> Cmd Msg
-sendMessage apiUrl token transactionId room msg contents = request
+sendTextMessage : ApiUrl -> ApiToken -> Int -> String -> String -> Cmd Msg
+sendTextMessage apiUrl token transactionId room message = request
     { method = "PUT"
     , headers = authenticatedHeaders token
     , url = (fullClientUrl apiUrl)
         ++ "/rooms/" ++ room
         ++ "/send/" ++ "m.room.message"
         ++ "/" ++ (String.fromInt transactionId)
-    , body = jsonBody <| object contents
-    , expect = expectWhatever msg
+    , body = jsonBody <| object
+        [ ("msgtype", string "m.text")
+        , ("body", string message)
+        ]
+    , expect = expectWhatever SendRoomTextResponse
     , timeout = Nothing
     , tracker = Nothing
     }
 
-sendTextMessage : ApiUrl -> ApiToken -> Int -> RoomId -> String -> Cmd Msg
-sendTextMessage apiUrl token transactionId room message = sendMessage apiUrl token transactionId room SendRoomTextResponse
-    [ ("msgtype", string "m.text")
-    , ("body", string message)
-    ]
-
-sendImageMessage : ApiUrl -> ApiToken -> Int -> RoomId -> String -> Cmd Msg
-sendImageMessage apiUrl token transactionId room message = sendMessage apiUrl token transactionId room SendImageResponse
-    [ ("msgtype", string "m.image")
-    , ("body", string "Image")
-    , ("url", string message)
-    ]
-
-sendFileMessage : ApiUrl -> ApiToken -> Int -> RoomId -> String -> Cmd Msg
-sendFileMessage apiUrl token transactionId room message = sendMessage apiUrl token transactionId room SendFileResponse
-    [ ("msgtype", string "m.file")
-    , ("body", string "File")
-    , ("url", string message)
-    ]
-
 login : ApiUrl -> Username -> Password -> Cmd Msg
 login apiUrl username password = request
     { method = "POST"

src/Scylla/Model.elm

@@ -10,7 +10,6 @@ import Browser.Dom exposing (Viewport)
 import Url.Builder
 import Dict exposing (Dict)
 import Time exposing (Posix)
-import File exposing (File)
 import Json.Decode
 import Browser
 import Http
@@ -53,14 +52,6 @@ type Msg =
     | TypingTick Posix -- Tick for updating the typing status
     | History RoomId -- Load history for a room
     | ReceiveHistoryResponse RoomId (Result Http.Error HistoryResponse) -- HTTP, receive history
-    | SendImages RoomId
-    | SendFiles RoomId
-    | ImagesSelected RoomId File (List File)
-    | FilesSelected RoomId File (List File)
-    | ImageUploadComplete RoomId (Result Http.Error String)
-    | FileUploadComplete RoomId (Result Http.Error String)
-    | SendImageResponse (Result Http.Error ())
-    | SendFileResponse (Result Http.Error ())
 
 displayName : Model -> Username -> String
 displayName m s = Maybe.withDefault (senderName s) <| Maybe.andThen .displayName <| Dict.get s m.userData
@@ -71,9 +62,6 @@ roomUrl s = Url.Builder.absolute [ "room", s ] []
 loginUrl : String
 loginUrl = Url.Builder.absolute [ "login" ] []
 
-newUsers : Model -> List Username -> List Username
-newUsers m lus = List.filter (\u -> not <| Dict.member u m.userData) lus
-
 currentRoom : Model -> Maybe JoinedRoom
 currentRoom m =
     let

src/Scylla/Sync.elm

@@ -448,9 +448,9 @@ roomStateEvents jr =
             , prevContent = Nothing
             , stateKey = ""
             }
-        allStateEvents = uniqueBy .eventId (stateEvents ++ (List.map roomToStateEvent timelineEvents))
+        allEvents = uniqueBy .eventId (stateEvents ++ (List.map roomToStateEvent timelineEvents))
     in
-        allStateEvents
+        allEvents
 
 roomAccountData : JoinedRoom -> String -> Maybe Decode.Value
 roomAccountData jr et =
@@ -495,21 +495,16 @@ roomTypingUsers jr = Maybe.withDefault []
     <| Maybe.andThen (findLast (((==) "m.typing") << .type_))
     <| Maybe.andThen .events jr.ephemeral
 
-allRoomDictEvents : Dict String { a | timeline : Maybe Timeline } -> List RoomEvent
-allRoomDictEvents dict = List.concatMap (Maybe.withDefault [] << .events)
-    <| List.filterMap .timeline
-    <| Dict.values dict
-
-allEvents : SyncResponse -> List RoomEvent
-allEvents s =
+roomsUsers : SyncResponse -> List Username
+roomsUsers s =
     let
-        eventsFor f = Maybe.withDefault []
-            <| Maybe.map allRoomDictEvents
-            <| Maybe.andThen f s.rooms
-        joinedEvents = eventsFor .join
-        leftEvents = eventsFor .leave
+        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 .eventId <| leftEvents ++ joinedEvents
-
-allUsers : SyncResponse -> List Username
-allUsers s = uniqueBy (\u -> u) <| List.map .sender <| allEvents s
+        uniqueBy (\u -> u) <| leftUsers ++ joinedUsers

src/Scylla/Views.elm

@@ -129,8 +129,6 @@ joinedRoomView m roomId jr =
                 , onEnterKey <| SendRoomText roomId
                 , 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" ]
             ]
     in

static/scss/style.scss

@@ -135,7 +135,7 @@ div.message-wrapper {
     flex-shrink: 0;
 
     input {
-        flex-grow: 12;   
+        flex-grow: 9;   
         margin: 3px;
     }