Read room state events from timeline, too.

src/Main.elm

@@ -1,5 +1,6 @@
 import Browser exposing (application, UrlRequest(..))
 import Browser.Navigation as Nav
+import Browser.Dom exposing (Viewport, setViewportOf)
 import Scylla.Sync exposing (..)
 import Scylla.Login exposing (..)
 import Scylla.Model exposing (..)
@@ -14,6 +15,7 @@ import Url.Builder
 import Html exposing (div, text)
 import Http
 import Dict
+import Task
 
 type alias Flags =
     { token : Maybe String
@@ -60,7 +62,9 @@ update msg model = case msg of
     AttemptLogin -> (model, Scylla.Http.login model.apiUrl model.loginUsername model.loginPassword) -- TODO 
     TryUrl urlRequest -> updateTryUrl model urlRequest
     OpenRoom s -> (model, Nav.pushUrl model.key <| roomUrl s)
-    ChangeRoute r -> ({ model | route = r }, Cmd.none)
+    ChangeRoute r -> updateChangeRoute model r
+    ViewportAfterMessage v -> updateViewportAfterMessage model v
+    ViewportChangeComplete _ -> (model, Cmd.none)
     ReceiveLoginResponse r -> updateLoginResponse model r
     ReceiveFirstSyncResponse r -> updateSyncResponse model r False
     ReceiveSyncResponse r -> updateSyncResponse model r True
@@ -68,6 +72,29 @@ update msg model = case msg of
     ChangeRoomText r t -> ({ model | roomText = Dict.insert r t model.roomText}, Cmd.none)
     SendRoomText r -> updateSendRoomText model r
     SendRoomTextResponse r -> (model, Cmd.none)
+    ReceiveCompletedReadMarker r -> (model, Cmd.none)
+
+updateChangeRoute : Model -> Route -> (Model, Cmd Msg)
+updateChangeRoute m r =
+    let
+        joinedRoom = case r of
+            Room rid -> Maybe.andThen (Dict.get rid) <| Maybe.andThen .join <| m.sync.rooms
+            _ -> Nothing
+        lastMessage = Maybe.andThen (findLastEvent (((==) "m.room.message") << .type_)) <| Maybe.andThen .events <| Maybe.andThen .timeline joinedRoom
+        readMarkerCmd = case (r, lastMessage) of
+            (Room rid, Just re) -> setReadMarkers m.apiUrl (Maybe.withDefault "" m.token) rid re.eventId <| Just re.eventId
+            _ -> Cmd.none
+    in
+        ({ m | route = r }, readMarkerCmd)
+
+updateViewportAfterMessage : Model -> Result Browser.Dom.Error Viewport -> (Model, Cmd Msg)
+updateViewportAfterMessage m vr = 
+    let
+        cmd vp = if vp.scene.height - (vp.viewport.y + vp.viewport.height ) < 100
+            then Task.attempt ViewportChangeComplete <| setViewportOf "events-wrapper" vp.viewport.x vp.scene.height
+            else Cmd.none
+    in
+        (m, Result.withDefault Cmd.none <| Result.map cmd vr)
 
 updateUserData : Model -> String -> Result Http.Error UserData -> (Model, Cmd Msg)
 updateUserData m s r = case r of
@@ -106,7 +133,7 @@ updateSyncResponse model r notify =
             <| Result.map .nextBatch r
         syncCmd = sync nextBatch model.apiUrl token
         newUsers sr = List.filter (\s -> not <| Dict.member s model.userData) <| roomsUsers sr
-        newUserCommands sr = Cmd.batch
+        newUserCmd sr = Cmd.batch
             <| List.map (userData model.apiUrl
             <| Maybe.withDefault "" model.token)
             <| newUsers sr
@@ -114,19 +141,39 @@ updateSyncResponse model r notify =
             (\(s, e) -> e.originServerTs)
             (\(s, e) -> e.sender /= model.loginUsername)
             <| notificationEvents sr
-        notificationCommand sr = Maybe.withDefault Cmd.none
+        notificationCmd sr = if notify
+            then Maybe.withDefault Cmd.none
                     <| Maybe.map (\(s, e) -> sendNotificationPort
                     { name = displayName model e.sender
                     , text = notificationText e
                     , room = s
-                })
-            <| notification sr
+                    }) <| notification sr
+            else Cmd.none
+        room = currentRoomId model
+        roomMessages sr = case room of
+            Just rid -> List.filter (((==) "m.room.message") << .type_)
+                <| Maybe.withDefault []
+                <| Maybe.andThen .events
+                <| Maybe.andThen .timeline
+                <| Maybe.andThen (Dict.get rid)
+                <| Maybe.andThen .join
+                <| sr.rooms
+            Nothing -> []
+        setScrollCmd sr = if List.isEmpty 
+            <| roomMessages sr
+                then Cmd.none
+                else Task.attempt ViewportAfterMessage (Browser.Dom.getViewportOf "events-wrapper")
+        setReadReceiptCmd sr = case (room, List.head <| List.reverse <| roomMessages sr) of
+            (Just rid, Just re) -> setReadMarkers model.apiUrl token rid re.eventId <| Just re.eventId
+            _ -> Cmd.none
     in
         case r of
             Ok sr -> ({ model | sync = mergeSyncResponse model.sync sr }, Cmd.batch
                 [ syncCmd
-                , newUserCommands sr
-                , if notify then notificationCommand sr else Cmd.none
+                , newUserCmd sr
+                , notificationCmd sr
+                , setScrollCmd sr
+                , setReadReceiptCmd sr
                 ])
             _ -> (model, syncCmd)
 

src/Scylla/Http.elm

@@ -1,21 +1,25 @@
 module Scylla.Http exposing (..)
 import Scylla.Model exposing (..)
 import Scylla.Api exposing (..)
+import Scylla.Route exposing (RoomId)
 import Scylla.Sync exposing (syncResponseDecoder)
 import Scylla.Login exposing (loginResponseDecoder, Username, Password)
 import Scylla.UserData exposing (userDataDecoder, UserData)
 import Json.Encode exposing (object, string, int)
 import Http exposing (request, emptyBody, jsonBody, expectJson, expectWhatever)
 
-fullUrl : ApiUrl -> ApiUrl
-fullUrl s = s ++ "/_matrix/client/r0"
+fullClientUrl : ApiUrl -> ApiUrl
+fullClientUrl s = s ++ "/_matrix/client/r0"
+
+fullMediaUrl : ApiUrl -> ApiUrl
+fullMediaUrl s = s ++ "/_matrix/media/r0"
 
 -- Http Requests
 firstSync : ApiUrl -> ApiToken -> Cmd Msg
 firstSync apiUrl token = request
     { method = "GET"
     , headers = authenticatedHeaders token
-    , url = (fullUrl apiUrl) ++ "/sync"
+    , url = (fullClientUrl apiUrl) ++ "/sync"
     , body = emptyBody
     , expect = expectJson ReceiveFirstSyncResponse syncResponseDecoder
     , timeout = Nothing
@@ -26,7 +30,7 @@ sync : String -> ApiUrl -> ApiToken -> Cmd Msg
 sync nextBatch apiUrl token = request
     { method = "GET"
     , headers = authenticatedHeaders token
-    , url = (fullUrl apiUrl) ++ "/sync" ++ "?since=" ++ (nextBatch) ++ "&timeout=10000"
+    , url = (fullClientUrl apiUrl) ++ "/sync" ++ "?since=" ++ (nextBatch) ++ "&timeout=10000"
     , body = emptyBody
     , expect = expectJson ReceiveSyncResponse syncResponseDecoder
     , timeout = Nothing
@@ -37,7 +41,7 @@ sendTextMessage : ApiUrl -> ApiToken -> Int -> String -> String -> Cmd Msg
 sendTextMessage apiUrl token transactionId room message = request
     { method = "PUT"
     , headers = authenticatedHeaders token
-    , url = (fullUrl apiUrl)
+    , url = (fullClientUrl apiUrl)
         ++ "/rooms/" ++ room
         ++ "/send/" ++ "m.room.message"
         ++ "/" ++ (String.fromInt transactionId)
@@ -54,7 +58,7 @@ login : ApiUrl -> Username -> Password -> Cmd Msg
 login apiUrl username password = request
     { method = "POST"
     , headers = basicHeaders
-    , url = (fullUrl apiUrl) ++ "/login"
+    , url = (fullClientUrl apiUrl) ++ "/login"
     , body = jsonBody <| object
         [ ("type", string "m.login.password")
         , ("identifier", object
@@ -72,9 +76,26 @@ userData : ApiUrl -> ApiToken -> Username -> Cmd Msg
 userData apiUrl token username = request
     { method = "GET"
     , headers = authenticatedHeaders token
-    , url = (fullUrl apiUrl) ++ "/profile/" ++ username
+    , url = (fullClientUrl apiUrl) ++ "/profile/" ++ username
     , body = emptyBody
     , expect = expectJson (ReceiveUserData username) userDataDecoder
     , timeout = Nothing
     , tracker = Nothing
     }
+
+setReadMarkers : ApiUrl -> ApiToken -> String -> RoomId -> Maybe String -> Cmd Msg
+setReadMarkers apiUrl token roomId fullyRead readReceipt =
+    let
+        readReciptFields = case readReceipt of
+            Just s -> [ ("m.read", string s) ]
+            _ -> []
+    in
+        request
+            { method = "POST"
+            , headers = authenticatedHeaders token
+            , url = (fullClientUrl apiUrl) ++ "/rooms/" ++ roomId ++ "/read_markers"
+            , body = jsonBody <| object <| [ ("m.fully_read", string fullyRead) ] ++ readReciptFields
+            , expect = expectWhatever ReceiveCompletedReadMarker
+            , timeout = Nothing
+            , tracker = Nothing
+            }

src/Scylla/Model.elm

@@ -3,8 +3,9 @@ import Scylla.Api exposing (..)
 import Scylla.Sync exposing (SyncResponse, JoinedRoom, senderName)
 import Scylla.Login exposing (LoginResponse, Username, Password)
 import Scylla.UserData exposing (UserData)
-import Scylla.Route exposing (Route)
+import Scylla.Route exposing (Route(..), RoomId)
 import Browser.Navigation as Nav
+import Browser.Dom exposing (Viewport)
 import Url.Builder
 import Dict exposing (Dict)
 import Browser
@@ -36,10 +37,13 @@ type Msg =
     | 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
+    | ViewportAfterMessage (Result Browser.Dom.Error Viewport) -- A message has been received, try scroll (maybe)
+    | ViewportChangeComplete (Result Browser.Dom.Error ()) -- We're done changing the viewport.
     | ReceiveFirstSyncResponse (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
     | ReceiveUserData Username (Result Http.Error UserData)
+    | ReceiveCompletedReadMarker (Result Http.Error ())
 
 displayName : Model -> Username -> String
 displayName m s = Maybe.withDefault (senderName s) <| Maybe.andThen .displayName <| Dict.get s m.userData
@@ -49,3 +53,15 @@ roomUrl s = Url.Builder.absolute [ "room", s ] []
 
 loginUrl : String
 loginUrl = Url.Builder.absolute [ "login" ] []
+
+currentRoom : Model -> Maybe JoinedRoom
+currentRoom m =
+    let
+        roomDict = Maybe.withDefault Dict.empty <| Maybe.andThen .join <| m.sync.rooms
+    in
+        Maybe.andThen (\s -> Dict.get s roomDict) <| currentRoomId m
+
+currentRoomId : Model -> Maybe RoomId
+currentRoomId m = case m.route of
+    Room r -> Just r
+    _ -> Nothing

src/Scylla/Sync.elm

@@ -387,11 +387,16 @@ senderName s =
 roomName : JoinedRoom -> Maybe String
 roomName jr = 
     let
-        state = jr.state
-        nameEvent = findLastEvent (((==) "m.room.name") << .type_)
-        name e = Result.toMaybe <| Decode.decodeValue (field "name" string) e.content
+        nameEvent = Maybe.andThen (findLastEvent (((==) "m.room.name") << .type_))
+            << Maybe.andThen .events
+        name c = Result.toMaybe <| Decode.decodeValue (field "name" string) c
+        maybeStateEvent = nameEvent jr.state
+        maybeTimelineEvent = nameEvent jr.timeline
+        realEventContent = case maybeTimelineEvent of
+            Just te -> Just te.content
+            _ -> Maybe.map .content maybeStateEvent
     in
-        Maybe.andThen name <| Maybe.andThen nameEvent <| Maybe.andThen .events <| state
+        Maybe.andThen name realEventContent
 
 -- Business Logic: Event Extraction
 notificationText : RoomEvent -> String

src/Scylla/Views.elm

@@ -4,15 +4,27 @@ import Scylla.Sync exposing (..)
 import Scylla.Route exposing (..)
 import Scylla.Fnv as Fnv
 import Scylla.Login exposing (Username)
+import Scylla.Http exposing (fullMediaUrl)
+import Scylla.Api exposing (ApiUrl)
 import Svg
 import Svg.Attributes
 import Url.Builder
 import Json.Decode as Decode
-import Html exposing (Html, div, input, text, button, div, span, a, h2, table, td, tr)
-import Html.Attributes exposing (type_, value, href, class, style)
-import Html.Events exposing (onInput, onClick)
+import Html exposing (Html, Attribute, div, input, text, button, div, span, a, h2, table, td, tr, img)
+import Html.Attributes exposing (type_, value, href, class, style, src, id)
+import Html.Events exposing (onInput, onClick, on)
 import Dict
 
+contentRepositoryDownloadUrl : ApiUrl -> String -> String
+contentRepositoryDownloadUrl apiUrl s =
+    let
+        lastIndex = Maybe.withDefault 6 <| List.head <| List.reverse <| String.indexes "/" s
+        authority = String.slice 6 lastIndex s
+        content = String.dropLeft (lastIndex + 1) s
+    in
+        (fullMediaUrl apiUrl) ++ "/download/" ++ authority ++ "/" ++ content
+
+
 stringColor : String -> String
 stringColor s = 
     let
@@ -114,6 +126,7 @@ joinedRoomView m roomId jr =
             [ input
                 [ type_ "text"
                 , onInput <| ChangeRoomText roomId
+                , onEnterKey <| SendRoomText roomId
                 , value <| Maybe.withDefault "" <| Dict.get roomId m.roomText
                 ]  []
             , button [ onClick <| SendRoomText roomId ] [ iconView "send" ]
@@ -126,6 +139,13 @@ joinedRoomView m roomId jr =
             , messageInput
             ]
 
+onEnterKey : Msg -> Attribute Msg
+onEnterKey msg =
+    let
+        isEnter code = if code == 13 then Decode.succeed msg else Decode.fail "Not ENTER"
+    in
+        on "keydown" (Decode.andThen isEnter <| Decode.field "keyCode" Decode.int)
+
 iconView : String -> Html Msg
 iconView name =
     let
@@ -136,7 +156,7 @@ iconView name =
             ] [ Svg.use [ Svg.Attributes.xlinkHref (url ++ "#" ++ name) ] [] ]
 
 eventWrapperView : Model -> List (Html Msg) -> Html Msg
-eventWrapperView m es = div [ class "events-wrapper" ] [ table [ class "events-table" ] es ]
+eventWrapperView m es = div [ class "events-wrapper", id "events-wrapper" ] [ table [ class "events-table" ] es ]
 
 eventView : Model -> RoomEvent -> Maybe (Html Msg)
 eventView m re = 
@@ -163,6 +183,7 @@ messageView m re =
     in
         case msgtype of
             Ok "m.text" -> messageTextView m re
+            Ok "m.image" -> messageImageView m re
             _ -> Nothing
 
 messageTextView : Model -> RoomEvent -> Maybe (Html Msg)
@@ -172,3 +193,12 @@ messageTextView m re =
         wrap mtext = span [] [ text mtext ]
     in
         Maybe.map wrap <| Result.toMaybe body
+
+messageImageView : Model -> RoomEvent -> Maybe (Html Msg)
+messageImageView m re =
+    let
+        body = Decode.decodeValue (Decode.field "url" Decode.string) re.content
+    in
+        Maybe.map (\s -> img [ class "message-image", src s ] [])
+            <| Maybe.map (contentRepositoryDownloadUrl m.apiUrl)
+            <| Result.toMaybe body

static/scss/style.scss

@@ -19,6 +19,7 @@ body {
     font-family: 'Open Sans', sans-serif;
     margin: 0px;
     background-color: $background-color;
+    font-size: 12px;
 }
 
 @mixin input-common {
@@ -122,11 +123,16 @@ div.room-wrapper {
     flex-direction: column;  
 }
 
+div.typing-wrapper {
+    padding: 5px;
+}
+
 /*
  * The message input and send button.
  */
 div.message-wrapper {
     display: flex;
+    flex-shrink: 0;
 
     input {
         flex-grow: 9;   
@@ -154,6 +160,11 @@ table.events-table {
         vertical-align: top;
     }
 
+    img {
+        max-width: 90%;
+        max-height: 400px;
+    }
+
     td:nth-child(1) {
         width: 10%;
         max-width: 100px;