Remove content-type from basic headers.

elm.json

@@ -9,6 +9,7 @@
             "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",
@@ -18,7 +19,6 @@
         },
         "indirect": {
             "elm/bytes": "1.0.7",
-            "elm/file": "1.0.1",
             "elm/virtual-dom": "1.0.2"
         }
     },

src/Main.elm

@@ -18,6 +18,8 @@ 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
@@ -80,11 +82,53 @@ 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 = case hr of
-    Ok h -> ({ m | sync = appendHistoryResponse m.sync r h }, Cmd.none)
-    Err _ -> (m, Cmd.none)
+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)
 
 updateHistory : Model -> RoomId -> (Model, Cmd Msg)
 updateHistory m r =
@@ -212,11 +256,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 sr
+            <| newUsers model
+            <| allUsers sr
         notification sr = findFirstBy
             (\(s, e) -> e.originServerTs)
             (\(s, e) -> e.sender /= model.loginUsername)

src/Scylla/Api.elm

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

src/Scylla/Http.elm

@@ -6,7 +6,10 @@ 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, expectJson, expectWhatever)
+import Http exposing (request, emptyBody, jsonBody, fileBody, expectJson, expectWhatever)
+import File exposing (File, name, mime)
+import Url.Builder as Builder
+import Json.Decode
 
 fullClientUrl : ApiUrl -> ApiUrl
 fullClientUrl s = s ++ "/_matrix/client/r0"
@@ -37,6 +40,17 @@ 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"
@@ -48,23 +62,40 @@ getHistory apiUrl token room prevBatch = request
     , tracker = Nothing
     }
 
-sendTextMessage : ApiUrl -> ApiToken -> Int -> String -> String -> Cmd Msg
-sendTextMessage apiUrl token transactionId room message = request
+sendMessage : ApiUrl -> ApiToken -> Int -> RoomId -> (Result Http.Error () -> Msg) -> List (String, Json.Encode.Value) -> Cmd Msg
+sendMessage apiUrl token transactionId room msg contents = request
     { method = "PUT"
     , headers = authenticatedHeaders token
     , url = (fullClientUrl apiUrl)
         ++ "/rooms/" ++ room
         ++ "/send/" ++ "m.room.message"
         ++ "/" ++ (String.fromInt transactionId)
-    , body = jsonBody <| object
-        [ ("msgtype", string "m.text")
-        , ("body", string message)
-        ]
-    , expect = expectWhatever SendRoomTextResponse
+    , body = jsonBody <| object contents
+    , expect = expectWhatever msg
     , 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,6 +10,7 @@ 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
@@ -52,6 +53,14 @@ 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
@@ -62,6 +71,9 @@ 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 = ""
             }
-        allEvents = uniqueBy .eventId (stateEvents ++ (List.map roomToStateEvent timelineEvents))
+        allStateEvents = uniqueBy .eventId (stateEvents ++ (List.map roomToStateEvent timelineEvents))
     in
-        allEvents
+        allStateEvents
 
 roomAccountData : JoinedRoom -> String -> Maybe Decode.Value
 roomAccountData jr et =
@@ -495,16 +495,21 @@ roomTypingUsers jr = Maybe.withDefault []
     <| Maybe.andThen (findLast (((==) "m.typing") << .type_))
     <| Maybe.andThen .events jr.ephemeral
 
-roomsUsers : SyncResponse -> List Username
-roomsUsers s =
+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 =
     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
+        eventsFor f = Maybe.withDefault []
+            <| Maybe.map allRoomDictEvents
+            <| Maybe.andThen f s.rooms
+        joinedEvents = eventsFor .join
+        leftEvents = eventsFor .leave
     in
-        uniqueBy (\u -> u) <| leftUsers ++ joinedUsers
+        uniqueBy .eventId <| leftEvents ++ joinedEvents
+
+allUsers : SyncResponse -> List Username
+allUsers s = uniqueBy (\u -> u) <| List.map .sender <| allEvents s

src/Scylla/Views.elm

@@ -129,6 +129,8 @@ 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: 9;   
+        flex-grow: 12;   
         margin: 3px;
     }