Handle WebSocket "delete" events. (#69)

* Handle WS delete events.
* Factor ws msg handlers to their own updater.

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
 
 
-
+type WebSocketEvent
--- Msg
+    = StatusUpdateEvent (Result String Status)
+    | NotificationEvent (Result String Notification)
+    | StatusDeleteEvent (Result String Int)
+    | ErrorEvent String
 
 
-type StatusListResult
+type WebSocketPayload
-    = Result Http.Error (List Status)
+    = StringPayload String
+    | IntPayload Int
 
 
-type alias AccessTokenResult =
+type alias WebSocketMessage =
-    { server : Server
+    { event : String
-    , accessToken : Token
+    , payload : WebSocketPayload
     }
 
 
@@ -396,11 +393,19 @@ statusDecoder =
         |> Pipe.required "visibility" Decode.string
 
 
-websocketEventDecoder : Decode.Decoder WebSocketEvent
+webSocketPayloadDecoder : Decode.Decoder WebSocketPayload
-websocketEventDecoder =
+webSocketPayloadDecoder =
-    Pipe.decode WebSocketEvent
+    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
 
 
-
+decodeWebSocketMessage : String -> WebSocketEvent
-{-
-   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 message =
-    let
+    case (Decode.decodeString webSocketEventDecoder message) of
-        websocketEvent =
+        Ok message ->
-            Decode.decodeString
+            case message.event of
-                websocketEventDecoder
+                "update" ->
-                message
+                    case message.payload of
-    in
+                        StringPayload payload ->
-        case websocketEvent of
+                            StatusUpdateEvent (Decode.decodeString statusDecoder payload)
-            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"
 
-            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

src/Model.elm

@@ -45,12 +45,13 @@ type MastodonMsg
     | UserTimeline (Result Mastodon.Error (List Mastodon.Status))
 
 
-type
+type WebSocketMsg
-    Msg
+    = NewWebsocketUserMessage String
-    {-
+    | NewWebsocketGlobalMessage String
-       FIXME: Mastodon server response messages should be extracted to their own
+    | NewWebsocketLocalMessage String
-       MastodonMsg type at some point.
+
-    -}
+
+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
-        case model.client of
+        Just client ->
-            Just client ->
+            let
-                [ Mastodon.subscribeToWebSockets
+                subs =
-                    client
+                    [ Mastodon.subscribeToWebSockets
-                    Mastodon.UserStream
+                        client
-                    NewWebsocketUserMessage
+                        Mastodon.UserStream
-                ]
+                        NewWebsocketUserMessage
-                    ++ (if model.useGlobalTimeline then
+                    ]
-                            [ Mastodon.subscribeToWebSockets
+                        ++ (if model.useGlobalTimeline then
-                                client
+                                [ Mastodon.subscribeToWebSockets
-                                Mastodon.GlobalPublicStream
+                                    client
-                                NewWebsocketGlobalMessage
+                                    Mastodon.GlobalPublicStream
-                            ]
+                                    NewWebsocketGlobalMessage
-                        else
+                                ]
-                            [ Mastodon.subscribeToWebSockets
+                            else
-                                client
+                                [ Mastodon.subscribeToWebSockets
-                                Mastodon.LocalPublicStream
+                                    client
-                                NewWebsocketLocalMessage
+                                    Mastodon.LocalPublicStream
-                            ]
+                                    NewWebsocketLocalMessage
-                       )
+                                ]
+                           )
+            in
+                Sub.batch <| List.map (Sub.map WebSocketEvent) subs
 
-            Nothing ->
+        Nothing ->
-                []
+            Sub.batch []