Add room message sending.

This commit is contained in:
Danila Fedorin 2018-12-09 23:38:43 -08:00
parent 5ac8e8cb36
commit b76e4bdf7d
4 changed files with 52 additions and 5 deletions

View File

@ -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

View File

@ -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"

View File

@ -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

View File

@ -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 []