Compare commits
No commits in common. "03c472a78dee19802356fc2fd2371192a9bc7b0c" and "437039bcc48131b1889fb1511abc5838049a20a9" have entirely different histories.
03c472a78d
...
437039bcc4
2
elm.json
2
elm.json
|
@ -9,7 +9,6 @@
|
||||||
"NoRedInk/elm-json-decode-pipeline": "1.0.0",
|
"NoRedInk/elm-json-decode-pipeline": "1.0.0",
|
||||||
"elm/browser": "1.0.1",
|
"elm/browser": "1.0.1",
|
||||||
"elm/core": "1.0.2",
|
"elm/core": "1.0.2",
|
||||||
"elm/file": "1.0.1",
|
|
||||||
"elm/html": "1.0.0",
|
"elm/html": "1.0.0",
|
||||||
"elm/http": "2.0.0",
|
"elm/http": "2.0.0",
|
||||||
"elm/json": "1.1.2",
|
"elm/json": "1.1.2",
|
||||||
|
@ -19,6 +18,7 @@
|
||||||
},
|
},
|
||||||
"indirect": {
|
"indirect": {
|
||||||
"elm/bytes": "1.0.7",
|
"elm/bytes": "1.0.7",
|
||||||
|
"elm/file": "1.0.1",
|
||||||
"elm/virtual-dom": "1.0.2"
|
"elm/virtual-dom": "1.0.2"
|
||||||
}
|
}
|
||||||
},
|
},
|
||||||
|
|
54
src/Main.elm
54
src/Main.elm
|
@ -18,8 +18,6 @@ import Json.Encode
|
||||||
import Json.Decode
|
import Json.Decode
|
||||||
import Time exposing (every)
|
import Time exposing (every)
|
||||||
import Html exposing (div, text)
|
import Html exposing (div, text)
|
||||||
import File exposing (File)
|
|
||||||
import File.Select as Select
|
|
||||||
import Http
|
import Http
|
||||||
import Dict
|
import Dict
|
||||||
import Task
|
import Task
|
||||||
|
@ -82,53 +80,11 @@ update msg model = case msg of
|
||||||
TypingTick _ -> updateTypingTick model
|
TypingTick _ -> updateTypingTick model
|
||||||
History r -> updateHistory model r
|
History r -> updateHistory model r
|
||||||
ReceiveHistoryResponse r hr -> updateHistoryResponse model r hr
|
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 : Model -> RoomId -> Result Http.Error HistoryResponse -> (Model, Cmd Msg)
|
||||||
updateHistoryResponse m r hr =
|
updateHistoryResponse m r hr = case hr of
|
||||||
let
|
Ok h -> ({ m | sync = appendHistoryResponse m.sync r h }, Cmd.none)
|
||||||
newUsersCmd h = Cmd.batch
|
Err _ -> (m, Cmd.none)
|
||||||
<| 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 : Model -> RoomId -> (Model, Cmd Msg)
|
||||||
updateHistory m r =
|
updateHistory m r =
|
||||||
|
@ -256,11 +212,11 @@ updateSyncResponse model r notify =
|
||||||
nextBatch = Result.withDefault model.sync.nextBatch
|
nextBatch = Result.withDefault model.sync.nextBatch
|
||||||
<| Result.map .nextBatch r
|
<| Result.map .nextBatch r
|
||||||
syncCmd = sync model.apiUrl token nextBatch
|
syncCmd = sync model.apiUrl token nextBatch
|
||||||
|
newUsers sr = List.filter (\s -> not <| Dict.member s model.userData) <| roomsUsers sr
|
||||||
newUserCmd sr = Cmd.batch
|
newUserCmd sr = Cmd.batch
|
||||||
<| List.map (userData model.apiUrl
|
<| List.map (userData model.apiUrl
|
||||||
<| Maybe.withDefault "" model.token)
|
<| Maybe.withDefault "" model.token)
|
||||||
<| newUsers model
|
<| newUsers sr
|
||||||
<| allUsers sr
|
|
||||||
notification sr = findFirstBy
|
notification sr = findFirstBy
|
||||||
(\(s, e) -> e.originServerTs)
|
(\(s, e) -> e.originServerTs)
|
||||||
(\(s, e) -> e.sender /= model.loginUsername)
|
(\(s, e) -> e.sender /= model.loginUsername)
|
||||||
|
|
|
@ -6,7 +6,9 @@ type alias ApiToken = String
|
||||||
type alias ApiUrl = String
|
type alias ApiUrl = String
|
||||||
|
|
||||||
basicHeaders : List Header
|
basicHeaders : List Header
|
||||||
basicHeaders = []
|
basicHeaders =
|
||||||
|
[ header "Content-Type" "application/json"
|
||||||
|
]
|
||||||
|
|
||||||
authenticatedHeaders : ApiToken -> List Header
|
authenticatedHeaders : ApiToken -> List Header
|
||||||
authenticatedHeaders token =
|
authenticatedHeaders token =
|
||||||
|
|
|
@ -6,10 +6,7 @@ import Scylla.Sync exposing (syncResponseDecoder, historyResponseDecoder)
|
||||||
import Scylla.Login exposing (loginResponseDecoder, Username, Password)
|
import Scylla.Login exposing (loginResponseDecoder, Username, Password)
|
||||||
import Scylla.UserData exposing (userDataDecoder, UserData)
|
import Scylla.UserData exposing (userDataDecoder, UserData)
|
||||||
import Json.Encode exposing (object, string, int, bool)
|
import Json.Encode exposing (object, string, int, bool)
|
||||||
import Http exposing (request, emptyBody, jsonBody, fileBody, expectJson, expectWhatever)
|
import Http exposing (request, emptyBody, jsonBody, expectJson, expectWhatever)
|
||||||
import File exposing (File, name, mime)
|
|
||||||
import Url.Builder as Builder
|
|
||||||
import Json.Decode
|
|
||||||
|
|
||||||
fullClientUrl : ApiUrl -> ApiUrl
|
fullClientUrl : ApiUrl -> ApiUrl
|
||||||
fullClientUrl s = s ++ "/_matrix/client/r0"
|
fullClientUrl s = s ++ "/_matrix/client/r0"
|
||||||
|
@ -40,17 +37,6 @@ sync apiUrl token nextBatch = request
|
||||||
, tracker = Nothing
|
, 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 -> ApiToken -> RoomId -> String -> Cmd Msg
|
||||||
getHistory apiUrl token room prevBatch = request
|
getHistory apiUrl token room prevBatch = request
|
||||||
{ method = "GET"
|
{ method = "GET"
|
||||||
|
@ -62,40 +48,23 @@ getHistory apiUrl token room prevBatch = request
|
||||||
, tracker = Nothing
|
, tracker = Nothing
|
||||||
}
|
}
|
||||||
|
|
||||||
sendMessage : ApiUrl -> ApiToken -> Int -> RoomId -> (Result Http.Error () -> Msg) -> List (String, Json.Encode.Value) -> Cmd Msg
|
sendTextMessage : ApiUrl -> ApiToken -> Int -> String -> String -> Cmd Msg
|
||||||
sendMessage apiUrl token transactionId room msg contents = request
|
sendTextMessage apiUrl token transactionId room message = request
|
||||||
{ method = "PUT"
|
{ method = "PUT"
|
||||||
, headers = authenticatedHeaders token
|
, headers = authenticatedHeaders token
|
||||||
, url = (fullClientUrl apiUrl)
|
, url = (fullClientUrl apiUrl)
|
||||||
++ "/rooms/" ++ room
|
++ "/rooms/" ++ room
|
||||||
++ "/send/" ++ "m.room.message"
|
++ "/send/" ++ "m.room.message"
|
||||||
++ "/" ++ (String.fromInt transactionId)
|
++ "/" ++ (String.fromInt transactionId)
|
||||||
, body = jsonBody <| object contents
|
, body = jsonBody <| object
|
||||||
, expect = expectWhatever msg
|
[ ("msgtype", string "m.text")
|
||||||
|
, ("body", string message)
|
||||||
|
]
|
||||||
|
, expect = expectWhatever SendRoomTextResponse
|
||||||
, timeout = Nothing
|
, timeout = Nothing
|
||||||
, tracker = 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 -> Cmd Msg
|
||||||
login apiUrl username password = request
|
login apiUrl username password = request
|
||||||
{ method = "POST"
|
{ method = "POST"
|
||||||
|
|
|
@ -10,7 +10,6 @@ import Browser.Dom exposing (Viewport)
|
||||||
import Url.Builder
|
import Url.Builder
|
||||||
import Dict exposing (Dict)
|
import Dict exposing (Dict)
|
||||||
import Time exposing (Posix)
|
import Time exposing (Posix)
|
||||||
import File exposing (File)
|
|
||||||
import Json.Decode
|
import Json.Decode
|
||||||
import Browser
|
import Browser
|
||||||
import Http
|
import Http
|
||||||
|
@ -53,14 +52,6 @@ type Msg =
|
||||||
| TypingTick Posix -- Tick for updating the typing status
|
| TypingTick Posix -- Tick for updating the typing status
|
||||||
| History RoomId -- Load history for a room
|
| History RoomId -- Load history for a room
|
||||||
| ReceiveHistoryResponse RoomId (Result Http.Error HistoryResponse) -- HTTP, receive history
|
| 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 : Model -> Username -> String
|
||||||
displayName m s = Maybe.withDefault (senderName s) <| Maybe.andThen .displayName <| Dict.get s m.userData
|
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 : String
|
||||||
loginUrl = Url.Builder.absolute [ "login" ] []
|
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 : Model -> Maybe JoinedRoom
|
||||||
currentRoom m =
|
currentRoom m =
|
||||||
let
|
let
|
||||||
|
|
|
@ -448,9 +448,9 @@ roomStateEvents jr =
|
||||||
, prevContent = Nothing
|
, prevContent = Nothing
|
||||||
, stateKey = ""
|
, stateKey = ""
|
||||||
}
|
}
|
||||||
allStateEvents = uniqueBy .eventId (stateEvents ++ (List.map roomToStateEvent timelineEvents))
|
allEvents = uniqueBy .eventId (stateEvents ++ (List.map roomToStateEvent timelineEvents))
|
||||||
in
|
in
|
||||||
allStateEvents
|
allEvents
|
||||||
|
|
||||||
roomAccountData : JoinedRoom -> String -> Maybe Decode.Value
|
roomAccountData : JoinedRoom -> String -> Maybe Decode.Value
|
||||||
roomAccountData jr et =
|
roomAccountData jr et =
|
||||||
|
@ -495,21 +495,16 @@ roomTypingUsers jr = Maybe.withDefault []
|
||||||
<| Maybe.andThen (findLast (((==) "m.typing") << .type_))
|
<| Maybe.andThen (findLast (((==) "m.typing") << .type_))
|
||||||
<| Maybe.andThen .events jr.ephemeral
|
<| Maybe.andThen .events jr.ephemeral
|
||||||
|
|
||||||
allRoomDictEvents : Dict String { a | timeline : Maybe Timeline } -> List RoomEvent
|
roomsUsers : SyncResponse -> List Username
|
||||||
allRoomDictEvents dict = List.concatMap (Maybe.withDefault [] << .events)
|
roomsUsers s =
|
||||||
<| List.filterMap .timeline
|
|
||||||
<| Dict.values dict
|
|
||||||
|
|
||||||
allEvents : SyncResponse -> List RoomEvent
|
|
||||||
allEvents s =
|
|
||||||
let
|
let
|
||||||
eventsFor f = Maybe.withDefault []
|
users dict =
|
||||||
<| Maybe.map allRoomDictEvents
|
List.map .sender
|
||||||
<| Maybe.andThen f s.rooms
|
<| (List.concatMap <| Maybe.withDefault [] << .events)
|
||||||
joinedEvents = eventsFor .join
|
<| (List.filterMap .timeline)
|
||||||
leftEvents = eventsFor .leave
|
<| Dict.values dict
|
||||||
|
usersFor f = Maybe.withDefault [] <| Maybe.map users <| Maybe.andThen f s.rooms
|
||||||
|
joinedUsers = usersFor .join
|
||||||
|
leftUsers = usersFor .leave
|
||||||
in
|
in
|
||||||
uniqueBy .eventId <| leftEvents ++ joinedEvents
|
uniqueBy (\u -> u) <| leftUsers ++ joinedUsers
|
||||||
|
|
||||||
allUsers : SyncResponse -> List Username
|
|
||||||
allUsers s = uniqueBy (\u -> u) <| List.map .sender <| allEvents s
|
|
||||||
|
|
|
@ -129,8 +129,6 @@ joinedRoomView m roomId jr =
|
||||||
, onEnterKey <| SendRoomText roomId
|
, onEnterKey <| SendRoomText roomId
|
||||||
, value <| Maybe.withDefault "" <| Dict.get roomId m.roomText
|
, 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" ]
|
, button [ onClick <| SendRoomText roomId ] [ iconView "send" ]
|
||||||
]
|
]
|
||||||
in
|
in
|
||||||
|
|
|
@ -135,7 +135,7 @@ div.message-wrapper {
|
||||||
flex-shrink: 0;
|
flex-shrink: 0;
|
||||||
|
|
||||||
input {
|
input {
|
||||||
flex-grow: 12;
|
flex-grow: 9;
|
||||||
margin: 3px;
|
margin: 3px;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user