Add sending images and files

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,10 +82,39 @@ update msg model = case msg of
     TypingTick _ -> updateTypingTick model
     History r -> updateHistory model r
     ReceiveHistoryResponse r hr -> updateHistoryResponse model r hr
-    SendImages rid -> (model, Cmd.none)
-    SendFiles rid -> (model, Cmd.none)
-    ImagesSelected rid f fs -> (model, Cmd.none)
-    FilesSelected rid f fs -> (model, Cmd.none)
+    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 =

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

@@ -57,6 +57,10 @@ type Msg =
     | 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

static/scss/style.scss

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