Handle WebSocket "delete" events. (#69)
* Handle WS delete events. * Factor ws msg handlers to their own updater.
This commit is contained in:
Nicolas Perriault
GitHub
parent
d40f110b59
commit
2de53bd103
135
src/Mastodon.elm
135
src/Mastodon.elm
|
|
@ -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
|
||||
|
|
|
|||
223
src/Model.elm
223
src/Model.elm
|
|
@ -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 []
|
||||
|
|
|
|||
Loading…
Reference in New Issue