Compare commits

...

2 Commits

6 changed files with 130 additions and 18 deletions

View File

@ -78,7 +78,27 @@ update msg model = case msg of
ReceiveCompletedTypingIndicator r -> (model, Cmd.none) ReceiveCompletedTypingIndicator r -> (model, Cmd.none)
ReceiveStoreData d -> updateStoreData model d ReceiveStoreData d -> updateStoreData model d
TypingTick _ -> updateTypingTick model TypingTick _ -> updateTypingTick model
History r -> updateHistory model r
ReceiveHistoryResponse r hr -> updateHistoryResponse model r hr
updateHistoryResponse : Model -> RoomId -> Result Http.Error HistoryResponse -> (Model, Cmd Msg)
updateHistoryResponse m r hr = case hr of
Ok h -> ({ m | sync = appendHistoryResponse m.sync r h }, Cmd.none)
Err _ -> (m, Cmd.none)
updateHistory : Model -> RoomId -> (Model, Cmd Msg)
updateHistory m r =
let
prevBatch = Maybe.andThen .prevBatch
<| Maybe.andThen .timeline
<| Maybe.andThen (Dict.get r)
<| Maybe.andThen .join
<| m.sync.rooms
command = case prevBatch of
Just pv -> getHistory m.apiUrl (Maybe.withDefault "" m.token) r pv
Nothing -> Cmd.none
in
(m, command)
updateChangeRoomText : Model -> RoomId -> String -> (Model, Cmd Msg) updateChangeRoomText : Model -> RoomId -> String -> (Model, Cmd Msg)
updateChangeRoomText m roomId text = updateChangeRoomText m roomId text =
@ -191,7 +211,7 @@ updateSyncResponse model r notify =
token = Maybe.withDefault "" model.token token = Maybe.withDefault "" model.token
nextBatch = Result.withDefault model.sync.nextBatch nextBatch = Result.withDefault model.sync.nextBatch
<| Result.map .nextBatch r <| Result.map .nextBatch r
syncCmd = sync nextBatch model.apiUrl token syncCmd = sync model.apiUrl token nextBatch
newUsers sr = List.filter (\s -> not <| Dict.member s model.userData) <| roomsUsers sr 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

View File

@ -2,7 +2,7 @@ module Scylla.Http exposing (..)
import Scylla.Model exposing (..) import Scylla.Model exposing (..)
import Scylla.Api exposing (..) import Scylla.Api exposing (..)
import Scylla.Route exposing (RoomId) import Scylla.Route exposing (RoomId)
import Scylla.Sync exposing (syncResponseDecoder) 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)
@ -26,8 +26,8 @@ firstSync apiUrl token = request
, tracker = Nothing , tracker = Nothing
} }
sync : String -> ApiUrl -> ApiToken -> Cmd Msg sync : ApiUrl -> ApiToken -> String -> Cmd Msg
sync nextBatch apiUrl token = request sync apiUrl token nextBatch = request
{ method = "GET" { method = "GET"
, headers = authenticatedHeaders token , headers = authenticatedHeaders token
, url = (fullClientUrl apiUrl) ++ "/sync" ++ "?since=" ++ (nextBatch) ++ "&timeout=10000" , url = (fullClientUrl apiUrl) ++ "/sync" ++ "?since=" ++ (nextBatch) ++ "&timeout=10000"
@ -37,6 +37,17 @@ sync nextBatch apiUrl token = request
, tracker = Nothing , tracker = Nothing
} }
getHistory : ApiUrl -> ApiToken -> RoomId -> String -> Cmd Msg
getHistory apiUrl token room prevBatch = request
{ method = "GET"
, headers = authenticatedHeaders token
, url = (fullClientUrl apiUrl) ++ "/rooms/" ++ room ++ "/messages" ++ "?from=" ++ prevBatch ++ "&dir=" ++ "b"
, body = emptyBody
, expect = expectJson (ReceiveHistoryResponse room) historyResponseDecoder
, timeout = Nothing
, tracker = Nothing
}
sendTextMessage : ApiUrl -> ApiToken -> Int -> String -> String -> Cmd Msg sendTextMessage : ApiUrl -> ApiToken -> Int -> String -> String -> Cmd Msg
sendTextMessage apiUrl token transactionId room message = request sendTextMessage apiUrl token transactionId room message = request
{ method = "PUT" { method = "PUT"

View File

@ -1,6 +1,6 @@
module Scylla.Model exposing (..) module Scylla.Model exposing (..)
import Scylla.Api exposing (..) import Scylla.Api exposing (..)
import Scylla.Sync exposing (SyncResponse, JoinedRoom, senderName) import Scylla.Sync exposing (SyncResponse, HistoryResponse, JoinedRoom, senderName)
import Scylla.Login exposing (LoginResponse, Username, Password) import Scylla.Login exposing (LoginResponse, Username, Password)
import Scylla.UserData exposing (UserData) import Scylla.UserData exposing (UserData)
import Scylla.Route exposing (Route(..), RoomId) import Scylla.Route exposing (Route(..), RoomId)
@ -50,6 +50,8 @@ type Msg =
| ReceiveCompletedTypingIndicator (Result Http.Error ()) -- HTTP, typing indicator request completed | ReceiveCompletedTypingIndicator (Result Http.Error ()) -- HTTP, typing indicator request completed
| ReceiveStoreData Json.Decode.Value -- We are send back a value on request from localStorage. | ReceiveStoreData Json.Decode.Value -- We are send back a value on request from localStorage.
| TypingTick Posix -- Tick for updating the typing status | TypingTick Posix -- Tick for updating the typing status
| History RoomId -- Load history for a room
| ReceiveHistoryResponse RoomId (Result Http.Error HistoryResponse) -- HTTP, receive history
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

View File

@ -2,6 +2,7 @@ module Scylla.Sync exposing (..)
import Scylla.Api exposing (..) import Scylla.Api exposing (..)
import Scylla.Notification exposing (..) import Scylla.Notification exposing (..)
import Scylla.Login exposing (Username) import Scylla.Login exposing (Username)
import Scylla.Route exposing (RoomId)
import Dict exposing (Dict) import Dict exposing (Dict)
import Json.Decode as Decode exposing (Decoder, int, string, float, list, value, dict, bool, field) import Json.Decode as Decode exposing (Decoder, int, string, float, list, value, dict, bool, field)
import Json.Decode.Pipeline exposing (required, optional) import Json.Decode.Pipeline exposing (required, optional)
@ -258,6 +259,20 @@ presenceDecoder =
Decode.succeed Presence Decode.succeed Presence
|> maybeDecode "events" (list eventDecoder) |> maybeDecode "events" (list eventDecoder)
-- Room History Responses
type alias HistoryResponse =
{ start : String
, end : String
, chunk : List RoomEvent
}
historyResponseDecoder : Decoder HistoryResponse
historyResponseDecoder =
Decode.succeed HistoryResponse
|> required "start" string
|> required "end" string
|> required "chunk" (list roomEventDecoder)
-- Business Logic -- Business Logic
uniqueByRecursive : (a -> comparable) -> List a -> Set comparable -> List a uniqueByRecursive : (a -> comparable) -> List a -> Set comparable -> List a
uniqueByRecursive f l s = case l of uniqueByRecursive f l s = case l of
@ -327,7 +342,7 @@ mergeState : State -> State -> State
mergeState s1 s2 = State <| mergeMaybe mergeStateEvents s1.events s2.events mergeState s1 s2 = State <| mergeMaybe mergeStateEvents s1.events s2.events
mergeTimeline : Timeline -> Timeline -> Timeline mergeTimeline : Timeline -> Timeline -> Timeline
mergeTimeline t1 t2 = Timeline (mergeMaybe mergeRoomEvents t1.events t2.events) Nothing t2.prevBatch mergeTimeline t1 t2 = Timeline (mergeMaybe mergeRoomEvents t1.events t2.events) Nothing t1.prevBatch
mergeEphemeral : Ephemeral -> Ephemeral -> Ephemeral mergeEphemeral : Ephemeral -> Ephemeral -> Ephemeral
mergeEphemeral e1 e2 = Ephemeral <| mergeMaybe mergeEvents e1.events e2.events mergeEphemeral e1 e2 = Ephemeral <| mergeMaybe mergeEvents e1.events e2.events
@ -374,6 +389,40 @@ mergeSyncResponse l r =
, accountData = mergeMaybe mergeAccountData l.accountData r.accountData , accountData = mergeMaybe mergeAccountData l.accountData r.accountData
} }
appendRoomHistoryResponse : JoinedRoom -> HistoryResponse -> JoinedRoom
appendRoomHistoryResponse jr hr =
let
oldEvents = Maybe.withDefault [] <| Maybe.andThen .events jr.timeline
newEvents = mergeRoomEvents (List.reverse hr.chunk) oldEvents
newTimeline = case jr.timeline of
Just t -> Just { t | events = Just newEvents, prevBatch = Just hr.end }
Nothing -> Just { events = Just newEvents, prevBatch = Just hr.end, limited = Nothing }
in
{ jr | timeline = newTimeline }
appendHistoryResponse : SyncResponse -> RoomId -> HistoryResponse -> SyncResponse
appendHistoryResponse sr r hr =
let
appendMaybeRoomHistoryResponse mr = Just <| case mr of
Just jr -> appendRoomHistoryResponse jr hr
Nothing ->
{ state = Nothing
, timeline = Just
{ events = Just hr.chunk
, limited = Nothing
, prevBatch = Just hr.end
}
, ephemeral = Nothing
, accountData = Nothing
, unreadNotifications = Nothing
}
newRooms = Just <| case sr.rooms of
Just rs -> { rs | join = newJoin rs.join }
Nothing -> { join = newJoin Nothing, leave = Nothing, invite = Nothing }
newJoin j = Maybe.map (Dict.update r appendMaybeRoomHistoryResponse) j
in
{ sr | rooms = newRooms }
-- Business Logic: Names -- Business Logic: Names
senderName : String -> String senderName : String -> String
senderName s = senderName s =
@ -384,19 +433,38 @@ senderName s =
in in
String.slice 1 colonIndex s String.slice 1 colonIndex s
roomStateEvents : JoinedRoom -> List StateEvent
roomStateEvents jr =
let
stateEvents = Maybe.withDefault [] <| Maybe.andThen .events jr.state
timelineEvents = Maybe.withDefault [] <| Maybe.andThen .events jr.timeline
roomToStateEvent re =
{ content = re.content
, type_ = re.type_
, eventId = re.eventId
, sender = re.sender
, originServerTs = re.originServerTs
, unsigned = re.unsigned
, prevContent = Nothing
, stateKey = ""
}
allEvents = uniqueBy .eventId (stateEvents ++ (List.map roomToStateEvent timelineEvents))
in
allEvents
roomAccountData : JoinedRoom -> String -> Maybe Decode.Value
roomAccountData jr et =
Maybe.map .content
<| Maybe.andThen (List.head << List.filter (((==) et) << .type_))
<| Maybe.andThen .events jr.accountData
roomName : JoinedRoom -> Maybe String roomName : JoinedRoom -> Maybe String
roomName jr = roomName jr =
let let
nameEvent = Maybe.andThen (findLastEvent (((==) "m.room.name") << .type_))
<< Maybe.andThen .events
name c = Result.toMaybe <| Decode.decodeValue (field "name" string) c name c = Result.toMaybe <| Decode.decodeValue (field "name" string) c
maybeStateEvent = nameEvent jr.state nameEvent = findLastEvent (((==) "m.room.name") << .type_) <| roomStateEvents jr
maybeTimelineEvent = nameEvent jr.timeline
realEventContent = case maybeTimelineEvent of
Just te -> Just te.content
_ -> Maybe.map .content maybeStateEvent
in in
Maybe.andThen name realEventContent Maybe.andThen (name << .content) nameEvent
-- Business Logic: Event Extraction -- Business Logic: Event Extraction
notificationText : RoomEvent -> String notificationText : RoomEvent -> String

View File

@ -109,12 +109,12 @@ loginView m = div [ class "login-wrapper" ]
, button [ onClick AttemptLogin ] [ text "Log In" ] , button [ onClick AttemptLogin ] [ text "Log In" ]
] ]
joinedRoomView : Model -> String -> JoinedRoom -> Html Msg joinedRoomView : Model -> RoomId -> JoinedRoom -> Html Msg
joinedRoomView m roomId 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
eventWrapper = eventWrapperView m renderedEvents eventWrapper = eventWrapperView m roomId renderedEvents
typing = List.map (displayName m) <| roomTypingUsers jr typing = List.map (displayName m) <| roomTypingUsers jr
typingText = String.join ", " typing typingText = String.join ", " typing
typingSuffix = case List.length typing of typingSuffix = case List.length typing of
@ -155,8 +155,11 @@ iconView name =
[ Svg.Attributes.class "feather-icon" [ Svg.Attributes.class "feather-icon"
] [ Svg.use [ Svg.Attributes.xlinkHref (url ++ "#" ++ name) ] [] ] ] [ Svg.use [ Svg.Attributes.xlinkHref (url ++ "#" ++ name) ] [] ]
eventWrapperView : Model -> List (Html Msg) -> Html Msg eventWrapperView : Model -> RoomId -> List (Html Msg) -> Html Msg
eventWrapperView m es = div [ class "events-wrapper", id "events-wrapper" ] [ table [ class "events-table" ] es ] eventWrapperView m rid es = div [ class "events-wrapper", id "events-wrapper" ]
[ a [ class "history-link", onClick <| History rid ] [ text "Load older messages" ]
, table [ class "events-table" ] es
]
eventView : Model -> RoomEvent -> Maybe (Html Msg) eventView : Model -> RoomEvent -> Maybe (Html Msg)
eventView m re = eventView m re =

View File

@ -148,6 +148,14 @@ div.message-wrapper {
div.events-wrapper { div.events-wrapper {
overflow-y: scroll; overflow-y: scroll;
flex-grow: 1; flex-grow: 1;
a.history-link {
display: block;
width: 100%;
text-align: center;
box-sizing: border-box;
padding: 5px;
}
} }
table.events-table { table.events-table {