Add room message sending.
This commit is contained in:
parent
5ac8e8cb36
commit
b76e4bdf7d
17
src/Main.elm
17
src/Main.elm
|
@ -11,6 +11,7 @@ import Url.Parser exposing (parse)
|
||||||
import Url.Builder
|
import Url.Builder
|
||||||
import Html exposing (div, text)
|
import Html exposing (div, text)
|
||||||
import Http
|
import Http
|
||||||
|
import Dict
|
||||||
|
|
||||||
type alias Flags =
|
type alias Flags =
|
||||||
{ token : Maybe String
|
{ token : Maybe String
|
||||||
|
@ -33,6 +34,8 @@ init flags url key =
|
||||||
, accountData = Nothing
|
, accountData = Nothing
|
||||||
}
|
}
|
||||||
, errors = []
|
, errors = []
|
||||||
|
, roomText = Dict.empty
|
||||||
|
, transactionId = 0
|
||||||
}
|
}
|
||||||
cmd = case flags.token of
|
cmd = case flags.token of
|
||||||
Just _ -> Cmd.none
|
Just _ -> Cmd.none
|
||||||
|
@ -56,6 +59,20 @@ update msg model = case msg of
|
||||||
ChangeRoute r -> ({ model | route = r }, Cmd.none)
|
ChangeRoute r -> ({ model | route = r }, Cmd.none)
|
||||||
ReceiveLoginResponse r -> updateLoginResponse model r
|
ReceiveLoginResponse r -> updateLoginResponse model r
|
||||||
ReceiveSyncResponse r -> updateSyncResponse model r
|
ReceiveSyncResponse r -> updateSyncResponse model r
|
||||||
|
ChangeRoomText r t -> ({ model | roomText = Dict.insert r t model.roomText}, Cmd.none)
|
||||||
|
SendRoomText r -> updateSendRoomText model r
|
||||||
|
SendRoomTextResponse r -> (model, Cmd.none)
|
||||||
|
|
||||||
|
updateSendRoomText : Model -> String -> (Model, Cmd Msg)
|
||||||
|
updateSendRoomText m r =
|
||||||
|
let
|
||||||
|
token = Maybe.withDefault "" m.token
|
||||||
|
message = Maybe.andThen (\s -> if s == "" then Nothing else Just s)
|
||||||
|
<| Dict.get r m.roomText
|
||||||
|
command = Maybe.withDefault Cmd.none
|
||||||
|
<| Maybe.map (sendTextMessage m.apiUrl token m.transactionId r) message
|
||||||
|
in
|
||||||
|
({ m | roomText = Dict.insert r "" m.roomText, transactionId = m.transactionId + 1 }, command)
|
||||||
|
|
||||||
updateTryUrl : Model -> Browser.UrlRequest -> (Model, Cmd Msg)
|
updateTryUrl : Model -> Browser.UrlRequest -> (Model, Cmd Msg)
|
||||||
updateTryUrl m ur = case ur of
|
updateTryUrl m ur = case ur of
|
||||||
|
|
|
@ -4,7 +4,7 @@ import Scylla.Api exposing (..)
|
||||||
import Scylla.Sync exposing (syncResponseDecoder)
|
import Scylla.Sync exposing (syncResponseDecoder)
|
||||||
import Scylla.Login exposing (loginResponseDecoder, Username, Password)
|
import Scylla.Login exposing (loginResponseDecoder, Username, Password)
|
||||||
import Json.Encode exposing (object, string, int)
|
import Json.Encode exposing (object, string, int)
|
||||||
import Http exposing (request, emptyBody, jsonBody, expectJson)
|
import Http exposing (request, emptyBody, jsonBody, expectJson, expectWhatever)
|
||||||
|
|
||||||
fullUrl : ApiUrl -> ApiUrl
|
fullUrl : ApiUrl -> ApiUrl
|
||||||
fullUrl s = s ++ "/_matrix/client/r0"
|
fullUrl s = s ++ "/_matrix/client/r0"
|
||||||
|
@ -32,6 +32,23 @@ sync nextBatch apiUrl token = request
|
||||||
, tracker = Nothing
|
, tracker = Nothing
|
||||||
}
|
}
|
||||||
|
|
||||||
|
sendTextMessage : ApiUrl -> ApiToken -> Int -> String -> String -> Cmd Msg
|
||||||
|
sendTextMessage apiUrl token transactionId room message = request
|
||||||
|
{ method = "PUT"
|
||||||
|
, headers = authenticatedHeaders token
|
||||||
|
, url = (fullUrl apiUrl)
|
||||||
|
++ "/rooms/" ++ room
|
||||||
|
++ "/send/" ++ "m.room.message"
|
||||||
|
++ "/" ++ (String.fromInt transactionId)
|
||||||
|
, body = jsonBody <| object
|
||||||
|
[ ("msgtype", string "m.text")
|
||||||
|
, ("body", string message)
|
||||||
|
]
|
||||||
|
, expect = expectWhatever SendRoomTextResponse
|
||||||
|
, timeout = Nothing
|
||||||
|
, tracker = Nothing
|
||||||
|
}
|
||||||
|
|
||||||
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"
|
||||||
|
|
|
@ -18,6 +18,8 @@ type alias Model =
|
||||||
, apiUrl : ApiUrl
|
, apiUrl : ApiUrl
|
||||||
, sync : SyncResponse
|
, sync : SyncResponse
|
||||||
, errors : List String
|
, errors : List String
|
||||||
|
, roomText : Dict String String
|
||||||
|
, transactionId : Int
|
||||||
}
|
}
|
||||||
|
|
||||||
type Msg =
|
type Msg =
|
||||||
|
@ -27,6 +29,9 @@ type Msg =
|
||||||
| AttemptLogin -- During login screen, login button presed
|
| AttemptLogin -- During login screen, login button presed
|
||||||
| TryUrl Browser.UrlRequest -- User attempts to change URL
|
| TryUrl Browser.UrlRequest -- User attempts to change URL
|
||||||
| ChangeRoute Route -- URL changes
|
| ChangeRoute Route -- URL changes
|
||||||
|
| ChangeRoomText String String -- Change to a room's input text
|
||||||
|
| SendRoomText String -- Sends a message typed into a given room's input
|
||||||
|
| SendRoomTextResponse (Result Http.Error ()) -- A send message response finished
|
||||||
| ReceiveSyncResponse (Result Http.Error SyncResponse) -- HTTP, Sync has finished
|
| ReceiveSyncResponse (Result Http.Error SyncResponse) -- HTTP, Sync has finished
|
||||||
| ReceiveLoginResponse (Result Http.Error LoginResponse) -- HTTP, Login has finished
|
| ReceiveLoginResponse (Result Http.Error LoginResponse) -- HTTP, Login has finished
|
||||||
|
|
||||||
|
|
|
@ -16,7 +16,7 @@ viewFull model =
|
||||||
Login -> loginView model
|
Login -> loginView model
|
||||||
Base -> baseView model
|
Base -> baseView model
|
||||||
Room r -> Maybe.withDefault (div [] [])
|
Room r -> Maybe.withDefault (div [] [])
|
||||||
<| Maybe.map (joinedRoomView model)
|
<| Maybe.map (joinedRoomView model r)
|
||||||
<| Maybe.andThen (Dict.get r)
|
<| Maybe.andThen (Dict.get r)
|
||||||
<| Maybe.andThen .join model.sync.rooms
|
<| Maybe.andThen .join model.sync.rooms
|
||||||
_ -> div [] []
|
_ -> div [] []
|
||||||
|
@ -52,14 +52,22 @@ loginView m = div []
|
||||||
, button [ onClick AttemptLogin ] [ text "Log In" ]
|
, button [ onClick AttemptLogin ] [ text "Log In" ]
|
||||||
]
|
]
|
||||||
|
|
||||||
joinedRoomView : Model -> JoinedRoom -> Html Msg
|
joinedRoomView : Model -> String -> JoinedRoom -> Html Msg
|
||||||
joinedRoomView m jr =
|
joinedRoomView m roomId jr =
|
||||||
let
|
let
|
||||||
events = Maybe.withDefault [] <| Maybe.andThen .events jr.timeline
|
events = Maybe.withDefault [] <| Maybe.andThen .events jr.timeline
|
||||||
renderedEvents = List.filterMap (eventView m) events
|
renderedEvents = List.filterMap (eventView m) events
|
||||||
eventContainer = eventContainerView m renderedEvents
|
eventContainer = eventContainerView m renderedEvents
|
||||||
|
messageInput = div []
|
||||||
|
[ input
|
||||||
|
[ type_ "text"
|
||||||
|
, onInput <| ChangeRoomText roomId
|
||||||
|
, value <| Maybe.withDefault "" <| Dict.get roomId m.roomText
|
||||||
|
] []
|
||||||
|
, button [ onClick <| SendRoomText roomId ] [ text "Send" ]
|
||||||
|
]
|
||||||
in
|
in
|
||||||
div [] [ eventContainer ]
|
div [] [ eventContainer, messageInput ]
|
||||||
|
|
||||||
eventContainerView : Model -> List (Html Msg) -> Html Msg
|
eventContainerView : Model -> List (Html Msg) -> Html Msg
|
||||||
eventContainerView m = div []
|
eventContainerView m = div []
|
||||||
|
|
Loading…
Reference in New Issue
Block a user