Handle WebSocket "delete" events. (#69)

* Handle WS delete events.
* Factor ws msg handlers to their own updater.
This commit is contained in:
Nicolas Perriault 2017-04-27 08:11:24 +02:00 committed by GitHub
parent d40f110b59
commit 2de53bd103
2 changed files with 200 additions and 158 deletions

View File

@ -14,7 +14,7 @@ module Mastodon
, StatusRequestBody
, StreamType(..)
, Tag
, WebSocketEventResult(..)
, WebSocketEvent(..)
, reblog
, unreblog
, favourite
@ -35,7 +35,6 @@ module Mastodon
, postStatus
, send
, subscribeToWebSockets
, websocketEventDecoder
, notificationDecoder
, addNotificationToAggregates
, notificationToAggregate
@ -87,18 +86,6 @@ type alias Token =
String
type alias Client =
{ server : Server
, token : Token
}
type alias WebSocketEvent =
{ event : String
, payload : String
}
type Error
= MastodonError StatusCode StatusMsg String
| ServerError StatusCode StatusMsg String
@ -106,6 +93,18 @@ type Error
| NetworkError
type alias AccessTokenResult =
{ server : Server
, accessToken : Token
}
type alias Client =
{ server : Server
, token : Token
}
type alias AppRegistration =
{ server : Server
, scope : String
@ -228,29 +227,27 @@ type alias Request a =
HttpBuilder.RequestBuilder a
type WebSocketEventResult a b c
= EventError a
| NotificationResult b
| StatusResult c
type StreamType
= UserStream
| LocalPublicStream
| GlobalPublicStream
-- Msg
type WebSocketEvent
= StatusUpdateEvent (Result String Status)
| NotificationEvent (Result String Notification)
| StatusDeleteEvent (Result String Int)
| ErrorEvent String
type StatusListResult
= Result Http.Error (List Status)
type WebSocketPayload
= StringPayload String
| IntPayload Int
type alias AccessTokenResult =
{ server : Server
, accessToken : Token
type alias WebSocketMessage =
{ event : String
, payload : WebSocketPayload
}
@ -396,11 +393,19 @@ statusDecoder =
|> Pipe.required "visibility" Decode.string
websocketEventDecoder : Decode.Decoder WebSocketEvent
websocketEventDecoder =
Pipe.decode WebSocketEvent
webSocketPayloadDecoder : Decode.Decoder WebSocketPayload
webSocketPayloadDecoder =
Decode.oneOf
[ Decode.map StringPayload Decode.string
, Decode.map IntPayload Decode.int
]
webSocketEventDecoder : Decode.Decoder WebSocketMessage
webSocketEventDecoder =
Pipe.decode WebSocketMessage
|> Pipe.required "event" Decode.string
|> Pipe.required "payload" Decode.string
|> Pipe.required "payload" webSocketPayloadDecoder
@ -733,41 +738,37 @@ subscribeToWebSockets client streamType message =
WebSocket.listen url message
{-
Sorry for this beast, but the websocket connection return messages
containing an escaped JSON string under the `payload` key. This JSON string
can either represent a `Notification` when the event field of the returned json
is equal to 'notification' or a `Status` when the string is equal to
'update'.
If someone has a better way of doing this, I'me all for it
-}
decodeWebSocketMessage : String -> WebSocketEventResult String (Result String Notification) (Result String Status)
decodeWebSocketMessage : String -> WebSocketEvent
decodeWebSocketMessage message =
let
websocketEvent =
Decode.decodeString
websocketEventDecoder
message
in
case websocketEvent of
Ok event ->
if event.event == "notification" then
NotificationResult
(Decode.decodeString
notificationDecoder
event.payload
)
else if event.event == "update" then
StatusResult
(Decode.decodeString
statusDecoder
event.payload
)
else
EventError "Unknown event type for WebSocket"
case (Decode.decodeString webSocketEventDecoder message) of
Ok message ->
case message.event of
"update" ->
case message.payload of
StringPayload payload ->
StatusUpdateEvent (Decode.decodeString statusDecoder payload)
Err error ->
EventError error
_ ->
ErrorEvent "WS status update event payload must be a string"
"delete" ->
case message.payload of
IntPayload payload ->
StatusDeleteEvent <| Ok payload
_ ->
ErrorEvent "WS status delete event payload must be an int"
"notification" ->
case message.payload of
StringPayload payload ->
NotificationEvent (Decode.decodeString notificationDecoder payload)
_ ->
ErrorEvent "WS notification event payload must be an string"
event ->
ErrorEvent <| "Unknown WS event " ++ event
Err error ->
ErrorEvent error

View File

@ -45,12 +45,13 @@ type MastodonMsg
| UserTimeline (Result Mastodon.Error (List Mastodon.Status))
type
Msg
{-
FIXME: Mastodon server response messages should be extracted to their own
MastodonMsg type at some point.
-}
type WebSocketMsg
= NewWebsocketUserMessage String
| NewWebsocketGlobalMessage String
| NewWebsocketLocalMessage String
type Msg
= AddFavorite Int
| DraftEvent DraftMsg
| MastodonEvent MastodonMsg
@ -65,10 +66,8 @@ type
| UseGlobalTimeline Bool
| ClearOpenedAccount
| Unreblog Int
| NewWebsocketUserMessage String
| NewWebsocketGlobalMessage String
| NewWebsocketLocalMessage String
| ViewerEvent ViewerMsg
| WebSocketEvent WebSocketMsg
type alias Draft =
@ -289,10 +288,14 @@ processReblog statusId flag model =
updateTimelinesWithBoolFlag statusId flag (\s -> { s | reblogged = Just flag }) model
deleteStatusFromTimeline : Int -> List Mastodon.Status -> List Mastodon.Status
deleteStatusFromTimeline statusId timeline =
timeline
|> List.filter (\s -> s.id /= statusId && (Mastodon.extractReblog s).id /= statusId)
updateDraft : DraftMsg -> Draft -> ( Draft, Cmd Msg )
updateDraft draftMsg draft =
-- TODO: later we'll probably want to handle more events like when the user
-- wants to add CW, medias, etc.
case draftMsg of
ClearDraft ->
defaultDraft ! []
@ -461,6 +464,91 @@ processMastodonEvent msg model =
{ model | userTimeline = [], errors = (errorText error) :: model.errors } ! []
processWebSocketMsg : WebSocketMsg -> Model -> ( Model, Cmd Msg )
processWebSocketMsg msg model =
case msg of
NewWebsocketUserMessage message ->
case (Mastodon.decodeWebSocketMessage message) of
Mastodon.ErrorEvent error ->
{ model | errors = error :: model.errors } ! []
Mastodon.StatusUpdateEvent result ->
case result of
Ok status ->
{ model | userTimeline = status :: model.userTimeline } ! []
Err error ->
{ model | errors = error :: model.errors } ! []
Mastodon.StatusDeleteEvent result ->
case result of
Ok id ->
{ model | userTimeline = deleteStatusFromTimeline id model.userTimeline } ! []
Err error ->
{ model | errors = error :: model.errors } ! []
Mastodon.NotificationEvent result ->
case result of
Ok notification ->
let
notifications =
Mastodon.addNotificationToAggregates notification model.notifications
in
{ model | notifications = notifications } ! []
Err error ->
{ model | errors = error :: model.errors } ! []
NewWebsocketLocalMessage message ->
case (Mastodon.decodeWebSocketMessage message) of
Mastodon.ErrorEvent error ->
{ model | errors = error :: model.errors } ! []
Mastodon.StatusUpdateEvent result ->
case result of
Ok status ->
{ model | localTimeline = status :: model.localTimeline } ! []
Err error ->
{ model | errors = error :: model.errors } ! []
Mastodon.StatusDeleteEvent result ->
case result of
Ok id ->
{ model | localTimeline = deleteStatusFromTimeline id model.localTimeline } ! []
Err error ->
{ model | errors = error :: model.errors } ! []
_ ->
model ! []
NewWebsocketGlobalMessage message ->
case (Mastodon.decodeWebSocketMessage message) of
Mastodon.ErrorEvent error ->
{ model | errors = error :: model.errors } ! []
Mastodon.StatusUpdateEvent result ->
case result of
Ok status ->
{ model | globalTimeline = status :: model.globalTimeline } ! []
Err error ->
{ model | errors = error :: model.errors } ! []
Mastodon.StatusDeleteEvent result ->
case result of
Ok id ->
{ model | globalTimeline = deleteStatusFromTimeline id model.globalTimeline } ! []
Err error ->
{ model | errors = error :: model.errors } ! []
_ ->
model ! []
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
@ -474,6 +562,13 @@ update msg model =
in
newModel ! [ commands ]
WebSocketEvent msg ->
let
( newModel, commands ) =
processWebSocketMsg msg model
in
newModel ! [ commands ]
ServerChange server ->
{ model | server = server } ! []
@ -575,87 +670,33 @@ update msg model =
ClearOpenedAccount ->
{ model | account = Nothing } ! []
NewWebsocketUserMessage message ->
let
logError label error message =
Debug.log (label ++ " WS error: " ++ error) message
in
case (Mastodon.decodeWebSocketMessage message) of
Mastodon.EventError error ->
{ model | errors = (logError "EventError" error message) :: model.errors } ! []
Mastodon.NotificationResult result ->
case result of
Ok notification ->
{ model | notifications = Mastodon.addNotificationToAggregates notification model.notifications } ! []
Err error ->
{ model | errors = (logError "NotificationResult" error message) :: model.errors } ! []
Mastodon.StatusResult result ->
case result of
Ok status ->
{ model | userTimeline = status :: model.userTimeline } ! []
Err error ->
{ model | errors = (logError "StatusResult" error message) :: model.errors } ! []
NewWebsocketLocalMessage message ->
case (Mastodon.decodeWebSocketMessage message) of
Mastodon.EventError error ->
{ model | errors = error :: model.errors } ! []
Mastodon.StatusResult result ->
case result of
Ok status ->
{ model | localTimeline = status :: model.localTimeline } ! []
Err error ->
{ model | errors = error :: model.errors } ! []
_ ->
model ! []
NewWebsocketGlobalMessage message ->
case (Mastodon.decodeWebSocketMessage message) of
Mastodon.EventError error ->
{ model | errors = error :: model.errors } ! []
Mastodon.StatusResult result ->
case result of
Ok status ->
{ model | globalTimeline = status :: model.globalTimeline } ! []
Err error ->
{ model | errors = error :: model.errors } ! []
_ ->
model ! []
subscriptions : Model -> Sub Msg
subscriptions model =
Sub.batch <|
case model.client of
Just client ->
[ Mastodon.subscribeToWebSockets
client
Mastodon.UserStream
NewWebsocketUserMessage
]
++ (if model.useGlobalTimeline then
[ Mastodon.subscribeToWebSockets
client
Mastodon.GlobalPublicStream
NewWebsocketGlobalMessage
]
else
[ Mastodon.subscribeToWebSockets
client
Mastodon.LocalPublicStream
NewWebsocketLocalMessage
]
)
case model.client of
Just client ->
let
subs =
[ Mastodon.subscribeToWebSockets
client
Mastodon.UserStream
NewWebsocketUserMessage
]
++ (if model.useGlobalTimeline then
[ Mastodon.subscribeToWebSockets
client
Mastodon.GlobalPublicStream
NewWebsocketGlobalMessage
]
else
[ Mastodon.subscribeToWebSockets
client
Mastodon.LocalPublicStream
NewWebsocketLocalMessage
]
)
in
Sub.batch <| List.map (Sub.map WebSocketEvent) subs
Nothing ->
[]
Nothing ->
Sub.batch []