diff --git a/src/Main.elm b/src/Main.elm index 1f41bd2..f51672d 100644 --- a/src/Main.elm +++ b/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 = diff --git a/src/Scylla/Http.elm b/src/Scylla/Http.elm index e886ee1..cb7cd0a 100644 --- a/src/Scylla/Http.elm +++ b/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" diff --git a/src/Scylla/Model.elm b/src/Scylla/Model.elm index 2217b2b..3725dfb 100644 --- a/src/Scylla/Model.elm +++ b/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 diff --git a/static/scss/style.scss b/static/scss/style.scss index f53f44a..5d9f203 100644 --- a/static/scss/style.scss +++ b/static/scss/style.scss @@ -135,7 +135,7 @@ div.message-wrapper { flex-shrink: 0; input { - flex-grow: 9; + flex-grow: 12; margin: 3px; }