Compare commits

...

6 Commits

7 changed files with 138 additions and 15 deletions

View File

@ -13,12 +13,12 @@
"elm/http": "2.0.0",
"elm/json": "1.1.2",
"elm/svg": "1.0.1",
"elm/time": "1.0.0",
"elm/url": "1.0.0"
},
"indirect": {
"elm/bytes": "1.0.7",
"elm/file": "1.0.1",
"elm/time": "1.0.0",
"elm/virtual-dom": "1.0.2"
}
},

View File

@ -7,7 +7,7 @@ import Scylla.Api exposing (..)
import Scylla.Model exposing (..)
import Scylla.Http exposing (..)
import Scylla.Views exposing (viewFull)
import Scylla.Route exposing (Route(..))
import Scylla.Route exposing (Route(..), RoomId)
import Scylla.UserData exposing (..)
import Scylla.Notification exposing (..)
import Scylla.Storage exposing (..)
@ -15,11 +15,16 @@ import Url exposing (Url)
import Url.Parser exposing (parse)
import Url.Builder
import Json.Encode
import Json.Decode
import Time exposing (every)
import Html exposing (div, text)
import Http
import Dict
import Task
syncTimeout = 10000
typingTimeout = 2000
type alias Flags =
{ token : Maybe String
}
@ -47,7 +52,7 @@ init flags url key =
}
cmd = case flags.token of
Just _ -> Cmd.none
Nothing -> Nav.pushUrl key <| Url.Builder.absolute [ "login" ] []
Nothing -> getStoreValuePort "scylla.loginInfo"
in
(model, cmd)
@ -72,10 +77,58 @@ update msg model = case msg of
ReceiveFirstSyncResponse r -> updateSyncResponse model r False
ReceiveSyncResponse r -> updateSyncResponse model r True
ReceiveUserData s r -> updateUserData model s r
ChangeRoomText r t -> ({ model | roomText = Dict.insert r t model.roomText}, Cmd.none)
ChangeRoomText r t -> updateChangeRoomText model r t
SendRoomText r -> updateSendRoomText model r
SendRoomTextResponse r -> (model, Cmd.none)
ReceiveCompletedReadMarker r -> (model, Cmd.none)
ReceiveCompletedTypingIndicator r -> (model, Cmd.none)
ReceiveStoreData d -> updateStoreData model d
TypingTick _ -> updateTypingTick model
updateChangeRoomText : Model -> RoomId -> String -> (Model, Cmd Msg)
updateChangeRoomText m roomId text =
let
typingIndicator = case (text, Dict.get roomId m.roomText) of
("", _) -> Just False
(_, Just "") -> Just True
(_, Nothing) -> Just True
_ -> Nothing
command = case typingIndicator of
Just b -> sendTypingIndicator m.apiUrl (Maybe.withDefault "" m.token) roomId m.loginUsername b typingTimeout
_ -> Cmd.none
in
({ m | roomText = Dict.insert roomId text m.roomText}, command)
updateTypingTick : Model -> (Model, Cmd Msg)
updateTypingTick m =
let
command = case currentRoomId m of
Just rid -> sendTypingIndicator m.apiUrl (Maybe.withDefault "" m.token) rid m.loginUsername True typingTimeout
Nothing -> Cmd.none
in
(m, command)
updateStoreData : Model -> Json.Encode.Value -> (Model, Cmd Msg)
updateStoreData m d = case (Json.Decode.decodeValue storeDataDecoder d) of
Ok { key, value } -> case key of
"scylla.loginInfo" -> updateLoginInfo m value
_ -> (m, Cmd.none)
Err _ -> (m, Cmd.none)
updateLoginInfo : Model -> Json.Encode.Value -> (Model, Cmd Msg)
updateLoginInfo m s = case Json.Decode.decodeValue (Json.Decode.map decodeLoginInfo Json.Decode.string) s of
Ok (Just { token, apiUrl, username, transactionId }) ->
(
{ m | token = Just token
, apiUrl = apiUrl
, loginUsername = username
, transactionId = transactionId
}
, firstSync apiUrl token
)
_ -> (m, Nav.pushUrl m.key <| Url.Builder.absolute [ "login" ] [])
updateChangeRoute : Model -> Route -> (Model, Cmd Msg)
updateChangeRoute m r =
@ -104,16 +157,23 @@ updateUserData m s r = case r of
Ok ud -> ({ m | userData = Dict.insert s ud m.userData }, Cmd.none)
Err e -> (m, userData m.apiUrl (Maybe.withDefault "" m.token) s)
updateSendRoomText : Model -> String -> (Model, Cmd Msg)
updateSendRoomText : Model -> RoomId -> (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
combinedCmd = case message of
Nothing -> Cmd.none
Just s -> Cmd.batch
[ sendTextMessage m.apiUrl token m.transactionId r s
, sendTypingIndicator m.apiUrl token r m.loginUsername False typingTimeout
, setStoreValuePort ("scylla.loginInfo", Json.Encode.string
<| encodeLoginInfo
<| LoginInfo (Maybe.withDefault "" m.token) m.apiUrl m.loginUsername (m.transactionId + 1))
]
in
({ m | roomText = Dict.insert r "" m.roomText, transactionId = m.transactionId + 1 }, command)
({ m | roomText = Dict.insert r "" m.roomText, transactionId = m.transactionId + 1 }, combinedCmd)
updateTryUrl : Model -> Browser.UrlRequest -> (Model, Cmd Msg)
updateTryUrl m ur = case ur of
@ -125,7 +185,7 @@ updateLoginResponse model a r = case r of
Ok lr -> ( { model | token = Just lr.accessToken, loginUsername = lr.userId, apiUrl = a }, Cmd.batch
[ firstSync model.apiUrl lr.accessToken
, Nav.pushUrl model.key <| Url.Builder.absolute [] []
, setStoreValuePort ("scylla.loginInfo", Json.Encode.string (lr.accessToken ++ "\n" ++ model.apiUrl))
, setStoreValuePort ("scylla.loginInfo", Json.Encode.string <| encodeLoginInfo (lr.accessToken, model.apiUrl, lr.userId))
] )
Err e -> (model, Cmd.none)
@ -182,7 +242,20 @@ updateSyncResponse model r notify =
_ -> (model, syncCmd)
subscriptions : Model -> Sub Msg
subscriptions m = onNotificationClickPort OpenRoom
subscriptions m =
let
currentText = Maybe.withDefault ""
<| Maybe.andThen (\rid -> Dict.get rid m.roomText)
<| currentRoomId m
typingTimer = case currentText of
"" -> Sub.none
_ -> every typingTimeout TypingTick
in
Sub.batch
[ onNotificationClickPort OpenRoom
, receiveStoreValuePort ReceiveStoreData
, typingTimer
]
onUrlRequest : Browser.UrlRequest -> Msg
onUrlRequest = TryUrl

View File

@ -5,7 +5,7 @@ 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 Json.Encode exposing (object, string, int, bool)
import Http exposing (request, emptyBody, jsonBody, expectJson, expectWhatever)
fullClientUrl : ApiUrl -> ApiUrl
@ -99,3 +99,14 @@ setReadMarkers apiUrl token roomId fullyRead readReceipt =
, timeout = Nothing
, tracker = Nothing
}
sendTypingIndicator : ApiUrl -> ApiToken -> RoomId -> Username -> Bool -> Int -> Cmd Msg
sendTypingIndicator apiUrl token room user isTyping timeout = request
{ method = "PUT"
, headers = authenticatedHeaders token
, url = (fullClientUrl apiUrl) ++ "/rooms/" ++ room ++ "/typing/" ++ user
, body = jsonBody <| object [ ("timeout", int timeout), ("typing", bool isTyping) ]
, expect = expectWhatever ReceiveCompletedTypingIndicator
, timeout = Nothing
, tracker = Nothing
}

View File

@ -1,11 +1,32 @@
module Scylla.Login exposing (..)
import Scylla.Api exposing (ApiToken)
import Scylla.Api exposing (ApiUrl, ApiToken)
import Json.Decode as Decode exposing (Decoder, int, string, float, list, value, dict, bool)
import Json.Decode.Pipeline exposing (required, optional)
import Json.Encode as Encode
type alias Username = String
type alias Password = String
type alias LoginInfo =
{ token : ApiToken
, apiUrl : ApiUrl
, username : Username
, transactionId : Int
}
encodeLoginInfo : LoginInfo -> String
encodeLoginInfo {token, apiUrl, username, transactionId} =
token ++ "," ++ apiUrl ++ "," ++ username ++ "," ++ (String.fromInt transactionId)
decodeLoginInfo : String -> Maybe LoginInfo
decodeLoginInfo s = case String.indexes "," s of
[ fst, snd, thd ] -> Just <| LoginInfo
(String.slice 0 fst s)
(String.slice (fst + 1) snd s)
(String.slice (snd + 1) thd s)
(Maybe.withDefault 0 <| String.toInt <| String.dropLeft (thd + 1) s)
_ -> Nothing
type alias LoginResponse =
{ userId : String
, accessToken : ApiToken

View File

@ -4,10 +4,13 @@ import Scylla.Sync exposing (SyncResponse, JoinedRoom, senderName)
import Scylla.Login exposing (LoginResponse, Username, Password)
import Scylla.UserData exposing (UserData)
import Scylla.Route exposing (Route(..), RoomId)
import Scylla.Storage exposing (..)
import Browser.Navigation as Nav
import Browser.Dom exposing (Viewport)
import Url.Builder
import Dict exposing (Dict)
import Time exposing (Posix)
import Json.Decode
import Browser
import Http
import Url exposing (Url)
@ -42,8 +45,11 @@ type Msg =
| ReceiveFirstSyncResponse (Result Http.Error SyncResponse) -- HTTP, Sync has finished
| ReceiveSyncResponse (Result Http.Error SyncResponse) -- HTTP, Sync has finished
| ReceiveLoginResponse ApiUrl (Result Http.Error LoginResponse) -- HTTP, Login has finished
| ReceiveUserData Username (Result Http.Error UserData)
| ReceiveCompletedReadMarker (Result Http.Error ())
| ReceiveUserData Username (Result Http.Error UserData) -- HTTP, receive user data
| ReceiveCompletedReadMarker (Result Http.Error ()) -- HTTP, read marker 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.
| TypingTick Posix -- Tick for updating the typing status
displayName : Model -> Username -> String
displayName m s = Maybe.withDefault (senderName s) <| Maybe.andThen .displayName <| Dict.get s m.userData

View File

@ -1,5 +1,17 @@
port module Scylla.Storage exposing (..)
import Json.Encode
import Json.Decode as Decode exposing (Decoder, int, string, float, list, value, dict, bool)
import Json.Decode.Pipeline exposing (required, optional)
type alias StoreData =
{ key : String
, value: Decode.Value
}
storeDataDecoder : Decoder StoreData
storeDataDecoder = Decode.succeed StoreData
|> required "key" string
|> required "value" value
port setStoreValuePort : (String, Json.Encode.Value) -> Cmd msg
port getStoreValuePort : (String) -> Cmd msg

View File

@ -5,6 +5,6 @@ function setupStorage(app) {
localStorage.setItem(key, value);
});
app.ports.getStoreValuePort.subscribe(function(data) {
app.ports.receiveStoreValuePort.send(localStorage.getItem(data));
app.ports.receiveStoreValuePort.send({ "key" : data, "value" : localStorage.getItem(data) });
});
}