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)
ReceiveStoreData d -> updateStoreData model d
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 m roomId text =
@ -191,7 +211,7 @@ updateSyncResponse model r notify =
token = Maybe.withDefault "" model.token
nextBatch = Result.withDefault model.sync.nextBatch
<| 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
newUserCmd sr = Cmd.batch
<| List.map (userData model.apiUrl

View File

@ -2,7 +2,7 @@ module Scylla.Http exposing (..)
import Scylla.Model exposing (..)
import Scylla.Api exposing (..)
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.UserData exposing (userDataDecoder, UserData)
import Json.Encode exposing (object, string, int, bool)
@ -26,8 +26,8 @@ firstSync apiUrl token = request
, tracker = Nothing
}
sync : String -> ApiUrl -> ApiToken -> Cmd Msg
sync nextBatch apiUrl token = request
sync : ApiUrl -> ApiToken -> String -> Cmd Msg
sync apiUrl token nextBatch = request
{ method = "GET"
, headers = authenticatedHeaders token
, url = (fullClientUrl apiUrl) ++ "/sync" ++ "?since=" ++ (nextBatch) ++ "&timeout=10000"
@ -37,6 +37,17 @@ sync nextBatch apiUrl token = request
, 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 token transactionId room message = request
{ method = "PUT"

View File

@ -1,6 +1,6 @@
module Scylla.Model 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.UserData exposing (UserData)
import Scylla.Route exposing (Route(..), RoomId)
@ -50,6 +50,8 @@ type Msg =
| ReceiveCompletedTypingIndicator (Result Http.Error ()) -- HTTP, typing indicator request completed
| ReceiveStoreData Json.Decode.Value -- We are send back a value on request from localStorage.
| 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 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.Notification exposing (..)
import Scylla.Login exposing (Username)
import Scylla.Route exposing (RoomId)
import Dict exposing (Dict)
import Json.Decode as Decode exposing (Decoder, int, string, float, list, value, dict, bool, field)
import Json.Decode.Pipeline exposing (required, optional)
@ -258,6 +259,20 @@ presenceDecoder =
Decode.succeed Presence
|> 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
uniqueByRecursive : (a -> comparable) -> List a -> Set comparable -> List a
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
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 e1 e2 = Ephemeral <| mergeMaybe mergeEvents e1.events e2.events
@ -374,6 +389,40 @@ mergeSyncResponse l r =
, 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
senderName : String -> String
senderName s =
@ -384,19 +433,38 @@ senderName s =
in
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 jr =
let
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
nameEvent = findLastEvent (((==) "m.room.name") << .type_) <| roomStateEvents jr
in
Maybe.andThen name realEventContent
Maybe.andThen (name << .content) nameEvent
-- Business Logic: Event Extraction
notificationText : RoomEvent -> String

View File

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

View File

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