diff --git a/src/Mastodon.elm b/src/Mastodon.elm index afb667b..64035de 100644 --- a/src/Mastodon.elm +++ b/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 diff --git a/src/Model.elm b/src/Model.elm index 11fbdea..8b09912 100644 --- a/src/Model.elm +++ b/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 []