diff --git a/elm-package.json b/elm-package.json index b8f478b..6ac9d18 100644 --- a/elm-package.json +++ b/elm-package.json @@ -10,6 +10,7 @@ "dependencies": { "NoRedInk/elm-decode-pipeline": "3.0.0 <= v < 4.0.0", "elm-community/list-extra": "6.0.0 <= v < 7.0.0", + "elm-community/string-extra": "1.3.3 <= v < 2.0.0", "elm-lang/core": "5.1.1 <= v < 6.0.0", "elm-lang/dom": "1.1.1 <= v < 2.0.0", "elm-lang/html": "2.0.0 <= v < 3.0.0", diff --git a/src/Mastodon.elm b/src/Mastodon.elm deleted file mode 100644 index 64035de..0000000 --- a/src/Mastodon.elm +++ /dev/null @@ -1,774 +0,0 @@ -module Mastodon - exposing - ( AccessTokenResult - , Account - , AppRegistration - , Attachment - , Client - , Error(..) - , Mention - , Notification - , NotificationAggregate - , Reblog(..) - , Status - , StatusRequestBody - , StreamType(..) - , Tag - , WebSocketEvent(..) - , reblog - , unreblog - , favourite - , unfavourite - , extractReblog - , register - , registrationEncoder - , aggregateNotifications - , clientEncoder - , decodeWebSocketMessage - , getAuthorizationUrl - , getAccessToken - , fetchAccount - , fetchLocalTimeline - , fetchNotifications - , fetchGlobalTimeline - , fetchUserTimeline - , postStatus - , send - , subscribeToWebSockets - , notificationDecoder - , addNotificationToAggregates - , notificationToAggregate - ) - -import Http -import HttpBuilder -import Json.Decode.Pipeline as Pipe -import Json.Decode as Decode -import Json.Encode as Encode -import Util -import WebSocket -import List.Extra exposing (groupWhile) -import Mastodon.ApiUrl as ApiUrl - - --- Types - - -type alias AccountId = - Int - - -type alias AuthCode = - String - - -type alias ClientId = - String - - -type alias ClientSecret = - String - - -type alias Server = - String - - -type alias StatusCode = - Int - - -type alias StatusMsg = - String - - -type alias Token = - String - - -type Error - = MastodonError StatusCode StatusMsg String - | ServerError StatusCode StatusMsg String - | TimeoutError - | NetworkError - - -type alias AccessTokenResult = - { server : Server - , accessToken : Token - } - - -type alias Client = - { server : Server - , token : Token - } - - -type alias AppRegistration = - { server : Server - , scope : String - , client_id : ClientId - , client_secret : ClientSecret - , id : Int - , redirect_uri : String - } - - -type alias Account = - { acct : String - , avatar : String - , created_at : String - , display_name : String - , followers_count : Int - , following_count : Int - , header : String - , id : AccountId - , locked : Bool - , note : String - , statuses_count : Int - , url : String - , username : String - } - - -type alias Attachment = - -- type_: -- "image", "video", "gifv" - { id : Int - , type_ : String - , url : String - , remote_url : String - , preview_url : String - , text_url : Maybe String - } - - -type alias Mention = - { id : AccountId - , url : String - , username : String - , acct : String - } - - -type alias Notification = - {- - - id: The notification ID - - type_: One of: "mention", "reblog", "favourite", "follow" - - created_at: The time the notification was created - - account: The Account sending the notification to the user - - status: The Status associated with the notification, if applicable - -} - { id : Int - , type_ : String - , created_at : String - , account : Account - , status : Maybe Status - } - - -type alias NotificationAggregate = - { type_ : String - , status : Maybe Status - , accounts : List Account - , created_at : String - } - - -type alias Tag = - { name : String - , url : String - } - - -type alias Status = - { account : Account - , content : String - , created_at : String - , favourited : Maybe Bool - , favourites_count : Int - , id : Int - , in_reply_to_account_id : Maybe Int - , in_reply_to_id : Maybe Int - , media_attachments : List Attachment - , mentions : List Mention - , reblog : Maybe Reblog - , reblogged : Maybe Bool - , reblogs_count : Int - , sensitive : Maybe Bool - , spoiler_text : String - , tags : List Tag - , uri : String - , url : String - , visibility : String - } - - -type Reblog - = Reblog Status - - -type alias StatusRequestBody = - -- status: The text of the status - -- in_reply_to_id: local ID of the status you want to reply to - -- sensitive: set this to mark the media of the status as NSFW - -- spoiler_text: text to be shown as a warning before the actual content - -- visibility: either "direct", "private", "unlisted" or "public" - -- TODO: media_ids: array of media IDs to attach to the status (maximum 4) - { status : String - , in_reply_to_id : Maybe Int - , spoiler_text : Maybe String - , sensitive : Bool - , visibility : String - } - - -type alias Request a = - HttpBuilder.RequestBuilder a - - -type StreamType - = UserStream - | LocalPublicStream - | GlobalPublicStream - - -type WebSocketEvent - = StatusUpdateEvent (Result String Status) - | NotificationEvent (Result String Notification) - | StatusDeleteEvent (Result String Int) - | ErrorEvent String - - -type WebSocketPayload - = StringPayload String - | IntPayload Int - - -type alias WebSocketMessage = - { event : String - , payload : WebSocketPayload - } - - - --- Encoders - - -appRegistrationEncoder : String -> String -> String -> String -> Encode.Value -appRegistrationEncoder client_name redirect_uris scope website = - Encode.object - [ ( "client_name", Encode.string client_name ) - , ( "redirect_uris", Encode.string redirect_uris ) - , ( "scopes", Encode.string scope ) - , ( "website", Encode.string website ) - ] - - -authorizationCodeEncoder : AppRegistration -> AuthCode -> Encode.Value -authorizationCodeEncoder registration authCode = - Encode.object - [ ( "client_id", Encode.string registration.client_id ) - , ( "client_secret", Encode.string registration.client_secret ) - , ( "grant_type", Encode.string "authorization_code" ) - , ( "redirect_uri", Encode.string registration.redirect_uri ) - , ( "code", Encode.string authCode ) - ] - - -statusRequestBodyEncoder : StatusRequestBody -> Encode.Value -statusRequestBodyEncoder statusData = - Encode.object - [ ( "status", Encode.string statusData.status ) - , ( "in_reply_to_id", encodeMaybe Encode.int statusData.in_reply_to_id ) - , ( "spoiler_text", encodeMaybe Encode.string statusData.spoiler_text ) - , ( "sensitive", Encode.bool statusData.sensitive ) - , ( "visibility", Encode.string statusData.visibility ) - ] - - - --- Decoders - - -appRegistrationDecoder : Server -> String -> Decode.Decoder AppRegistration -appRegistrationDecoder server scope = - Pipe.decode AppRegistration - |> Pipe.hardcoded server - |> Pipe.hardcoded scope - |> Pipe.required "client_id" Decode.string - |> Pipe.required "client_secret" Decode.string - |> Pipe.required "id" Decode.int - |> Pipe.required "redirect_uri" Decode.string - - -accessTokenDecoder : AppRegistration -> Decode.Decoder AccessTokenResult -accessTokenDecoder registration = - Pipe.decode AccessTokenResult - |> Pipe.hardcoded registration.server - |> Pipe.required "access_token" Decode.string - - -accountDecoder : Decode.Decoder Account -accountDecoder = - Pipe.decode Account - |> Pipe.required "acct" Decode.string - |> Pipe.required "avatar" Decode.string - |> Pipe.required "created_at" Decode.string - |> Pipe.required "display_name" Decode.string - |> Pipe.required "followers_count" Decode.int - |> Pipe.required "following_count" Decode.int - |> Pipe.required "header" Decode.string - |> Pipe.required "id" Decode.int - |> Pipe.required "locked" Decode.bool - |> Pipe.required "note" Decode.string - |> Pipe.required "statuses_count" Decode.int - |> Pipe.required "url" Decode.string - |> Pipe.required "username" Decode.string - - -attachmentDecoder : Decode.Decoder Attachment -attachmentDecoder = - Pipe.decode Attachment - |> Pipe.required "id" Decode.int - |> Pipe.required "type" Decode.string - |> Pipe.required "url" Decode.string - |> Pipe.required "remote_url" Decode.string - |> Pipe.required "preview_url" Decode.string - |> Pipe.required "text_url" (Decode.nullable Decode.string) - - -mentionDecoder : Decode.Decoder Mention -mentionDecoder = - Pipe.decode Mention - |> Pipe.required "id" Decode.int - |> Pipe.required "url" Decode.string - |> Pipe.required "username" Decode.string - |> Pipe.required "acct" Decode.string - - -notificationDecoder : Decode.Decoder Notification -notificationDecoder = - Pipe.decode Notification - |> Pipe.required "id" Decode.int - |> Pipe.required "type" Decode.string - |> Pipe.required "created_at" Decode.string - |> Pipe.required "account" accountDecoder - |> Pipe.optional "status" (Decode.nullable statusDecoder) Nothing - - -tagDecoder : Decode.Decoder Tag -tagDecoder = - Pipe.decode Tag - |> Pipe.required "name" Decode.string - |> Pipe.required "url" Decode.string - - -reblogDecoder : Decode.Decoder Reblog -reblogDecoder = - Decode.map Reblog (Decode.lazy (\_ -> statusDecoder)) - - -statusDecoder : Decode.Decoder Status -statusDecoder = - Pipe.decode Status - |> Pipe.required "account" accountDecoder - |> Pipe.required "content" Decode.string - |> Pipe.required "created_at" Decode.string - |> Pipe.optional "favourited" (Decode.nullable Decode.bool) Nothing - |> Pipe.required "favourites_count" Decode.int - |> Pipe.required "id" Decode.int - |> Pipe.required "in_reply_to_account_id" (Decode.nullable Decode.int) - |> Pipe.required "in_reply_to_id" (Decode.nullable Decode.int) - |> Pipe.required "media_attachments" (Decode.list attachmentDecoder) - |> Pipe.required "mentions" (Decode.list mentionDecoder) - |> Pipe.optional "reblog" (Decode.nullable reblogDecoder) Nothing - |> Pipe.optional "reblogged" (Decode.nullable Decode.bool) Nothing - |> Pipe.required "reblogs_count" Decode.int - |> Pipe.required "sensitive" (Decode.nullable Decode.bool) - |> Pipe.required "spoiler_text" Decode.string - |> Pipe.required "tags" (Decode.list tagDecoder) - |> Pipe.required "uri" Decode.string - |> Pipe.required "url" Decode.string - |> Pipe.required "visibility" Decode.string - - -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" webSocketPayloadDecoder - - - --- Internal helpers - - -encodeMaybe : (a -> Encode.Value) -> Maybe a -> Encode.Value -encodeMaybe encode thing = - case thing of - Nothing -> - Encode.null - - Just value -> - encode value - - -encodeUrl : String -> List ( String, String ) -> String -encodeUrl base params = - List.map (\( k, v ) -> k ++ "=" ++ Http.encodeUri v) params - |> String.join "&" - |> (++) (base ++ "?") - - -mastodonErrorDecoder : Decode.Decoder String -mastodonErrorDecoder = - Decode.field "error" Decode.string - - -extractMastodonError : StatusCode -> StatusMsg -> String -> Error -extractMastodonError statusCode statusMsg body = - case Decode.decodeString mastodonErrorDecoder body of - Ok errRecord -> - MastodonError statusCode statusMsg errRecord - - Err err -> - ServerError statusCode statusMsg err - - -extractError : Http.Error -> Error -extractError error = - case error of - Http.BadStatus { status, body } -> - extractMastodonError status.code status.message body - - Http.BadPayload str { status } -> - ServerError - status.code - status.message - ("Failed decoding JSON: " ++ str) - - Http.Timeout -> - TimeoutError - - _ -> - NetworkError - - -extractReblog : Status -> Status -extractReblog status = - case status.reblog of - Just (Reblog reblog) -> - reblog - - Nothing -> - status - - -toResponse : Result Http.Error a -> Result Error a -toResponse result = - Result.mapError extractError result - - -fetch : Client -> String -> Decode.Decoder a -> Request a -fetch client endpoint decoder = - HttpBuilder.get (client.server ++ endpoint) - |> HttpBuilder.withHeader "Authorization" ("Bearer " ++ client.token) - |> HttpBuilder.withExpect (Http.expectJson decoder) - - - --- Public API - - -notificationToAggregate : Notification -> NotificationAggregate -notificationToAggregate notification = - NotificationAggregate - notification.type_ - notification.status - [ notification.account ] - notification.created_at - - -addNotificationToAggregates : Notification -> List NotificationAggregate -> List NotificationAggregate -addNotificationToAggregates notification aggregates = - let - addNewAccountToSameStatus : NotificationAggregate -> Notification -> NotificationAggregate - addNewAccountToSameStatus aggregate notification = - case ( aggregate.status, notification.status ) of - ( Just aggregateStatus, Just notificationStatus ) -> - if aggregateStatus.id == notificationStatus.id then - { aggregate | accounts = notification.account :: aggregate.accounts } - else - aggregate - - ( _, _ ) -> - aggregate - - {- - Let's try to find an already existing aggregate, matching the notification - we are trying to add. - If we find any aggregate, we modify it inplace. If not, we return the - aggregates unmodified - -} - newAggregates = - aggregates - |> List.map - (\aggregate -> - case ( aggregate.type_, notification.type_ ) of - {- - Notification and aggregate are of the follow type. - Add the new following account. - -} - ( "follow", "follow" ) -> - { aggregate | accounts = notification.account :: aggregate.accounts } - - {- - Notification is of type follow, but current aggregate - is of another type. Let's continue then. - -} - ( _, "follow" ) -> - aggregate - - {- - If both types are the same check if we should - add the new account. - -} - ( aggregateType, notificationType ) -> - if aggregateType == notificationType then - addNewAccountToSameStatus aggregate notification - else - aggregate - ) - in - {- - If we did no modification to the old aggregates it's - because we didn't found any match. So me have to create - a new aggregate - -} - if newAggregates == aggregates then - notificationToAggregate (notification) :: aggregates - else - newAggregates - - -aggregateNotifications : List Notification -> List NotificationAggregate -aggregateNotifications notifications = - let - only type_ notifications = - List.filter (\n -> n.type_ == type_) notifications - - sameStatus n1 n2 = - case ( n1.status, n2.status ) of - ( Just r1, Just r2 ) -> - r1.id == r2.id - - _ -> - False - - extractAggregate statusGroup = - let - accounts = - List.map .account statusGroup - in - case statusGroup of - notification :: _ -> - [ NotificationAggregate - notification.type_ - notification.status - accounts - notification.created_at - ] - - [] -> - [] - - aggregate statusGroups = - List.map extractAggregate statusGroups |> List.concat - in - [ notifications |> only "reblog" |> groupWhile sameStatus |> aggregate - , notifications |> only "favourite" |> groupWhile sameStatus |> aggregate - , notifications |> only "mention" |> groupWhile sameStatus |> aggregate - , notifications |> only "follow" |> groupWhile (\_ _ -> True) |> aggregate - ] - |> List.concat - |> List.sortBy .created_at - |> List.reverse - - -clientEncoder : Client -> Encode.Value -clientEncoder client = - Encode.object - [ ( "server", Encode.string client.server ) - , ( "token", Encode.string client.token ) - ] - - -registrationEncoder : AppRegistration -> Encode.Value -registrationEncoder registration = - Encode.object - [ ( "server", Encode.string registration.server ) - , ( "scope", Encode.string registration.scope ) - , ( "client_id", Encode.string registration.client_id ) - , ( "client_secret", Encode.string registration.client_secret ) - , ( "id", Encode.int registration.id ) - , ( "redirect_uri", Encode.string registration.redirect_uri ) - ] - - -register : Server -> String -> String -> String -> String -> Request AppRegistration -register server client_name redirect_uri scope website = - HttpBuilder.post (ApiUrl.apps server) - |> HttpBuilder.withExpect (Http.expectJson (appRegistrationDecoder server scope)) - |> HttpBuilder.withJsonBody (appRegistrationEncoder client_name redirect_uri scope website) - - -getAuthorizationUrl : AppRegistration -> String -getAuthorizationUrl registration = - encodeUrl (ApiUrl.oauthAuthorize registration.server) - [ ( "response_type", "code" ) - , ( "client_id", registration.client_id ) - , ( "scope", registration.scope ) - , ( "redirect_uri", registration.redirect_uri ) - ] - - -getAccessToken : AppRegistration -> AuthCode -> Request AccessTokenResult -getAccessToken registration authCode = - HttpBuilder.post (ApiUrl.oauthToken registration.server) - |> HttpBuilder.withExpect (Http.expectJson (accessTokenDecoder registration)) - |> HttpBuilder.withJsonBody (authorizationCodeEncoder registration authCode) - - -send : (Result Error a -> msg) -> Request a -> Cmd msg -send tagger builder = - builder |> HttpBuilder.send (toResponse >> tagger) - - -fetchAccount : Client -> AccountId -> Request Account -fetchAccount client accountId = - fetch client (ApiUrl.account accountId) accountDecoder - - -fetchUserTimeline : Client -> Request (List Status) -fetchUserTimeline client = - fetch client ApiUrl.homeTimeline <| Decode.list statusDecoder - - -fetchLocalTimeline : Client -> Request (List Status) -fetchLocalTimeline client = - fetch client (ApiUrl.publicTimeline (Just "public")) <| Decode.list statusDecoder - - -fetchGlobalTimeline : Client -> Request (List Status) -fetchGlobalTimeline client = - fetch client (ApiUrl.publicTimeline (Nothing)) <| Decode.list statusDecoder - - -fetchNotifications : Client -> Request (List Notification) -fetchNotifications client = - fetch client (ApiUrl.notifications) <| Decode.list notificationDecoder - - -postStatus : Client -> StatusRequestBody -> Request Status -postStatus client statusRequestBody = - HttpBuilder.post (ApiUrl.statuses client.server) - |> HttpBuilder.withHeader "Authorization" ("Bearer " ++ client.token) - |> HttpBuilder.withExpect (Http.expectJson statusDecoder) - |> HttpBuilder.withJsonBody (statusRequestBodyEncoder statusRequestBody) - - -reblog : Client -> Int -> Request Status -reblog client id = - HttpBuilder.post (ApiUrl.reblog client.server id) - |> HttpBuilder.withHeader "Authorization" ("Bearer " ++ client.token) - |> HttpBuilder.withExpect (Http.expectJson statusDecoder) - - -unreblog : Client -> Int -> Request Status -unreblog client id = - HttpBuilder.post (ApiUrl.unreblog client.server id) - |> HttpBuilder.withHeader "Authorization" ("Bearer " ++ client.token) - |> HttpBuilder.withExpect (Http.expectJson statusDecoder) - - -favourite : Client -> Int -> Request Status -favourite client id = - HttpBuilder.post (ApiUrl.favourite client.server id) - |> HttpBuilder.withHeader "Authorization" ("Bearer " ++ client.token) - |> HttpBuilder.withExpect (Http.expectJson statusDecoder) - - -unfavourite : Client -> Int -> Request Status -unfavourite client id = - HttpBuilder.post (ApiUrl.unfavourite client.server id) - |> HttpBuilder.withHeader "Authorization" ("Bearer " ++ client.token) - |> HttpBuilder.withExpect (Http.expectJson statusDecoder) - - -subscribeToWebSockets : Client -> StreamType -> (String -> a) -> Sub a -subscribeToWebSockets client streamType message = - let - type_ = - case streamType of - GlobalPublicStream -> - "public" - - LocalPublicStream -> - "public:local" - - UserStream -> - "user" - - url = - encodeUrl - (ApiUrl.streaming (Util.replace "https:" "wss:" client.server)) - [ ( "access_token", client.token ) - , ( "stream", type_ ) - ] - in - WebSocket.listen url message - - -decodeWebSocketMessage : String -> WebSocketEvent -decodeWebSocketMessage message = - case (Decode.decodeString webSocketEventDecoder message) of - Ok message -> - case message.event of - "update" -> - case message.payload of - StringPayload payload -> - StatusUpdateEvent (Decode.decodeString statusDecoder payload) - - _ -> - 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/Mastodon/Decoder.elm b/src/Mastodon/Decoder.elm new file mode 100644 index 0000000..6c43a9b --- /dev/null +++ b/src/Mastodon/Decoder.elm @@ -0,0 +1,179 @@ +module Mastodon.Decoder + exposing + ( appRegistrationDecoder + , accessTokenDecoder + , accountDecoder + , attachmentDecoder + , decodeWebSocketMessage + , mastodonErrorDecoder + , mentionDecoder + , notificationDecoder + , tagDecoder + , reblogDecoder + , statusDecoder + , webSocketPayloadDecoder + , webSocketEventDecoder + ) + +import Json.Decode as Decode +import Json.Decode.Pipeline as Pipe +import Mastodon.Model exposing (..) +import Mastodon.WebSocket exposing (..) + + +appRegistrationDecoder : String -> String -> Decode.Decoder AppRegistration +appRegistrationDecoder server scope = + Pipe.decode AppRegistration + |> Pipe.hardcoded server + |> Pipe.hardcoded scope + |> Pipe.required "client_id" Decode.string + |> Pipe.required "client_secret" Decode.string + |> Pipe.required "id" Decode.int + |> Pipe.required "redirect_uri" Decode.string + + +accessTokenDecoder : AppRegistration -> Decode.Decoder AccessTokenResult +accessTokenDecoder registration = + Pipe.decode AccessTokenResult + |> Pipe.hardcoded registration.server + |> Pipe.required "access_token" Decode.string + + +accountDecoder : Decode.Decoder Account +accountDecoder = + Pipe.decode Account + |> Pipe.required "acct" Decode.string + |> Pipe.required "avatar" Decode.string + |> Pipe.required "created_at" Decode.string + |> Pipe.required "display_name" Decode.string + |> Pipe.required "followers_count" Decode.int + |> Pipe.required "following_count" Decode.int + |> Pipe.required "header" Decode.string + |> Pipe.required "id" Decode.int + |> Pipe.required "locked" Decode.bool + |> Pipe.required "note" Decode.string + |> Pipe.required "statuses_count" Decode.int + |> Pipe.required "url" Decode.string + |> Pipe.required "username" Decode.string + + +attachmentDecoder : Decode.Decoder Attachment +attachmentDecoder = + Pipe.decode Attachment + |> Pipe.required "id" Decode.int + |> Pipe.required "type" Decode.string + |> Pipe.required "url" Decode.string + |> Pipe.required "remote_url" Decode.string + |> Pipe.required "preview_url" Decode.string + |> Pipe.required "text_url" (Decode.nullable Decode.string) + + +mastodonErrorDecoder : Decode.Decoder String +mastodonErrorDecoder = + Decode.field "error" Decode.string + + +mentionDecoder : Decode.Decoder Mention +mentionDecoder = + Pipe.decode Mention + |> Pipe.required "id" Decode.int + |> Pipe.required "url" Decode.string + |> Pipe.required "username" Decode.string + |> Pipe.required "acct" Decode.string + + +notificationDecoder : Decode.Decoder Notification +notificationDecoder = + Pipe.decode Notification + |> Pipe.required "id" Decode.int + |> Pipe.required "type" Decode.string + |> Pipe.required "created_at" Decode.string + |> Pipe.required "account" accountDecoder + |> Pipe.optional "status" (Decode.nullable statusDecoder) Nothing + + +tagDecoder : Decode.Decoder Tag +tagDecoder = + Pipe.decode Tag + |> Pipe.required "name" Decode.string + |> Pipe.required "url" Decode.string + + +reblogDecoder : Decode.Decoder Reblog +reblogDecoder = + Decode.map Reblog (Decode.lazy (\_ -> statusDecoder)) + + +statusDecoder : Decode.Decoder Status +statusDecoder = + Pipe.decode Status + |> Pipe.required "account" accountDecoder + |> Pipe.required "content" Decode.string + |> Pipe.required "created_at" Decode.string + |> Pipe.optional "favourited" (Decode.nullable Decode.bool) Nothing + |> Pipe.required "favourites_count" Decode.int + |> Pipe.required "id" Decode.int + |> Pipe.required "in_reply_to_account_id" (Decode.nullable Decode.int) + |> Pipe.required "in_reply_to_id" (Decode.nullable Decode.int) + |> Pipe.required "media_attachments" (Decode.list attachmentDecoder) + |> Pipe.required "mentions" (Decode.list mentionDecoder) + |> Pipe.optional "reblog" (Decode.lazy (\_ -> Decode.nullable reblogDecoder)) Nothing + |> Pipe.optional "reblogged" (Decode.nullable Decode.bool) Nothing + |> Pipe.required "reblogs_count" Decode.int + |> Pipe.required "sensitive" (Decode.nullable Decode.bool) + |> Pipe.required "spoiler_text" Decode.string + |> Pipe.required "tags" (Decode.list tagDecoder) + |> Pipe.required "uri" Decode.string + |> Pipe.required "url" Decode.string + |> Pipe.required "visibility" Decode.string + + +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" webSocketPayloadDecoder + + +decodeWebSocketMessage : String -> WebSocketEvent +decodeWebSocketMessage message = + case (Decode.decodeString webSocketEventDecoder message) of + Ok message -> + case message.event of + "update" -> + case message.payload of + StringPayload payload -> + StatusUpdateEvent (Decode.decodeString statusDecoder payload) + + _ -> + 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/Mastodon/Encoder.elm b/src/Mastodon/Encoder.elm new file mode 100644 index 0000000..36d14ff --- /dev/null +++ b/src/Mastodon/Encoder.elm @@ -0,0 +1,82 @@ +module Mastodon.Encoder + exposing + ( encodeUrl + , appRegistrationEncoder + , authorizationCodeEncoder + , clientEncoder + , registrationEncoder + , statusRequestBodyEncoder + ) + +import Http +import Json.Encode as Encode +import Mastodon.Model exposing (..) + + +encodeMaybe : (a -> Encode.Value) -> Maybe a -> Encode.Value +encodeMaybe encode thing = + case thing of + Nothing -> + Encode.null + + Just value -> + encode value + + +encodeUrl : String -> List ( String, String ) -> String +encodeUrl base params = + List.map (\( k, v ) -> k ++ "=" ++ Http.encodeUri v) params + |> String.join "&" + |> (++) (base ++ "?") + + +appRegistrationEncoder : String -> String -> String -> String -> Encode.Value +appRegistrationEncoder client_name redirect_uris scope website = + Encode.object + [ ( "client_name", Encode.string client_name ) + , ( "redirect_uris", Encode.string redirect_uris ) + , ( "scopes", Encode.string scope ) + , ( "website", Encode.string website ) + ] + + +authorizationCodeEncoder : AppRegistration -> String -> Encode.Value +authorizationCodeEncoder registration authCode = + Encode.object + [ ( "client_id", Encode.string registration.client_id ) + , ( "client_secret", Encode.string registration.client_secret ) + , ( "grant_type", Encode.string "authorization_code" ) + , ( "redirect_uri", Encode.string registration.redirect_uri ) + , ( "code", Encode.string authCode ) + ] + + +clientEncoder : Client -> Encode.Value +clientEncoder client = + Encode.object + [ ( "server", Encode.string client.server ) + , ( "token", Encode.string client.token ) + ] + + +registrationEncoder : AppRegistration -> Encode.Value +registrationEncoder registration = + Encode.object + [ ( "server", Encode.string registration.server ) + , ( "scope", Encode.string registration.scope ) + , ( "client_id", Encode.string registration.client_id ) + , ( "client_secret", Encode.string registration.client_secret ) + , ( "id", Encode.int registration.id ) + , ( "redirect_uri", Encode.string registration.redirect_uri ) + ] + + +statusRequestBodyEncoder : StatusRequestBody -> Encode.Value +statusRequestBodyEncoder statusData = + Encode.object + [ ( "status", Encode.string statusData.status ) + , ( "in_reply_to_id", encodeMaybe Encode.int statusData.in_reply_to_id ) + , ( "spoiler_text", encodeMaybe Encode.string statusData.spoiler_text ) + , ( "sensitive", Encode.bool statusData.sensitive ) + , ( "visibility", Encode.string statusData.visibility ) + ] diff --git a/src/Mastodon/Helper.elm b/src/Mastodon/Helper.elm new file mode 100644 index 0000000..bd96e84 --- /dev/null +++ b/src/Mastodon/Helper.elm @@ -0,0 +1,141 @@ +module Mastodon.Helper + exposing + ( extractReblog + , aggregateNotifications + , addNotificationToAggregates + , notificationToAggregate + ) + +import List.Extra exposing (groupWhile) +import Mastodon.Model + exposing + ( Notification + , NotificationAggregate + , Reblog(..) + , Status + ) + + +extractReblog : Status -> Status +extractReblog status = + case status.reblog of + Just (Reblog reblog) -> + reblog + + Nothing -> + status + + +notificationToAggregate : Notification -> NotificationAggregate +notificationToAggregate notification = + NotificationAggregate + notification.type_ + notification.status + [ notification.account ] + notification.created_at + + +addNotificationToAggregates : Notification -> List NotificationAggregate -> List NotificationAggregate +addNotificationToAggregates notification aggregates = + let + addNewAccountToSameStatus : NotificationAggregate -> Notification -> NotificationAggregate + addNewAccountToSameStatus aggregate notification = + case ( aggregate.status, notification.status ) of + ( Just aggregateStatus, Just notificationStatus ) -> + if aggregateStatus.id == notificationStatus.id then + { aggregate | accounts = notification.account :: aggregate.accounts } + else + aggregate + + ( _, _ ) -> + aggregate + + {- + Let's try to find an already existing aggregate, matching the notification + we are trying to add. + If we find any aggregate, we modify it inplace. If not, we return the + aggregates unmodified + -} + newAggregates = + aggregates + |> List.map + (\aggregate -> + case ( aggregate.type_, notification.type_ ) of + {- + Notification and aggregate are of the follow type. + Add the new following account. + -} + ( "follow", "follow" ) -> + { aggregate | accounts = notification.account :: aggregate.accounts } + + {- + Notification is of type follow, but current aggregate + is of another type. Let's continue then. + -} + ( _, "follow" ) -> + aggregate + + {- + If both types are the same check if we should + add the new account. + -} + ( aggregateType, notificationType ) -> + if aggregateType == notificationType then + addNewAccountToSameStatus aggregate notification + else + aggregate + ) + in + {- + If we did no modification to the old aggregates it's + because we didn't found any match. So me have to create + a new aggregate + -} + if newAggregates == aggregates then + notificationToAggregate (notification) :: aggregates + else + newAggregates + + +aggregateNotifications : List Notification -> List NotificationAggregate +aggregateNotifications notifications = + let + only type_ notifications = + List.filter (\n -> n.type_ == type_) notifications + + sameStatus n1 n2 = + case ( n1.status, n2.status ) of + ( Just r1, Just r2 ) -> + r1.id == r2.id + + _ -> + False + + extractAggregate statusGroup = + let + accounts = + List.map .account statusGroup + in + case statusGroup of + notification :: _ -> + [ NotificationAggregate + notification.type_ + notification.status + accounts + notification.created_at + ] + + [] -> + [] + + aggregate statusGroups = + List.map extractAggregate statusGroups |> List.concat + in + [ notifications |> only "reblog" |> groupWhile sameStatus |> aggregate + , notifications |> only "favourite" |> groupWhile sameStatus |> aggregate + , notifications |> only "mention" |> groupWhile sameStatus |> aggregate + , notifications |> only "follow" |> groupWhile (\_ _ -> True) |> aggregate + ] + |> List.concat + |> List.sortBy .created_at + |> List.reverse diff --git a/src/Mastodon/Http.elm b/src/Mastodon/Http.elm new file mode 100644 index 0000000..b61c3eb --- /dev/null +++ b/src/Mastodon/Http.elm @@ -0,0 +1,161 @@ +module Mastodon.Http + exposing + ( Request + , reblog + , unreblog + , favourite + , unfavourite + , register + , getAuthorizationUrl + , getAccessToken + , fetchAccount + , fetchLocalTimeline + , fetchNotifications + , fetchGlobalTimeline + , fetchUserTimeline + , postStatus + , send + ) + +import Http +import HttpBuilder +import Json.Decode as Decode +import Mastodon.ApiUrl as ApiUrl +import Mastodon.Decoder exposing (..) +import Mastodon.Encoder exposing (..) +import Mastodon.Model exposing (..) + + +type alias Request a = + HttpBuilder.RequestBuilder a + + +extractMastodonError : Int -> String -> String -> Error +extractMastodonError statusCode statusMsg body = + case Decode.decodeString mastodonErrorDecoder body of + Ok errRecord -> + MastodonError statusCode statusMsg errRecord + + Err err -> + ServerError statusCode statusMsg err + + +extractError : Http.Error -> Error +extractError error = + case error of + Http.BadStatus { status, body } -> + extractMastodonError status.code status.message body + + Http.BadPayload str { status } -> + ServerError + status.code + status.message + ("Failed decoding JSON: " ++ str) + + Http.Timeout -> + TimeoutError + + _ -> + NetworkError + + +toResponse : Result Http.Error a -> Result Error a +toResponse result = + Result.mapError extractError result + + +fetch : Client -> String -> Decode.Decoder a -> Request a +fetch client endpoint decoder = + HttpBuilder.get (client.server ++ endpoint) + |> HttpBuilder.withHeader "Authorization" ("Bearer " ++ client.token) + |> HttpBuilder.withExpect (Http.expectJson decoder) + + +register : String -> String -> String -> String -> String -> Request AppRegistration +register server client_name redirect_uri scope website = + HttpBuilder.post (ApiUrl.apps server) + |> HttpBuilder.withExpect (Http.expectJson (appRegistrationDecoder server scope)) + |> HttpBuilder.withJsonBody (appRegistrationEncoder client_name redirect_uri scope website) + + +getAuthorizationUrl : AppRegistration -> String +getAuthorizationUrl registration = + encodeUrl (ApiUrl.oauthAuthorize registration.server) + [ ( "response_type", "code" ) + , ( "client_id", registration.client_id ) + , ( "scope", registration.scope ) + , ( "redirect_uri", registration.redirect_uri ) + ] + + +getAccessToken : AppRegistration -> String -> Request AccessTokenResult +getAccessToken registration authCode = + HttpBuilder.post (ApiUrl.oauthToken registration.server) + |> HttpBuilder.withExpect (Http.expectJson (accessTokenDecoder registration)) + |> HttpBuilder.withJsonBody (authorizationCodeEncoder registration authCode) + + +send : (Result Error a -> msg) -> Request a -> Cmd msg +send tagger builder = + builder |> HttpBuilder.send (toResponse >> tagger) + + +fetchAccount : Client -> Int -> Request Account +fetchAccount client accountId = + fetch client (ApiUrl.account accountId) accountDecoder + + +fetchUserTimeline : Client -> Request (List Status) +fetchUserTimeline client = + fetch client ApiUrl.homeTimeline <| Decode.list statusDecoder + + +fetchLocalTimeline : Client -> Request (List Status) +fetchLocalTimeline client = + fetch client (ApiUrl.publicTimeline (Just "public")) <| Decode.list statusDecoder + + +fetchGlobalTimeline : Client -> Request (List Status) +fetchGlobalTimeline client = + fetch client (ApiUrl.publicTimeline (Nothing)) <| Decode.list statusDecoder + + +fetchNotifications : Client -> Request (List Notification) +fetchNotifications client = + fetch client (ApiUrl.notifications) <| Decode.list notificationDecoder + + +postStatus : Client -> StatusRequestBody -> Request Status +postStatus client statusRequestBody = + HttpBuilder.post (ApiUrl.statuses client.server) + |> HttpBuilder.withHeader "Authorization" ("Bearer " ++ client.token) + |> HttpBuilder.withExpect (Http.expectJson statusDecoder) + |> HttpBuilder.withJsonBody (statusRequestBodyEncoder statusRequestBody) + + +reblog : Client -> Int -> Request Status +reblog client id = + HttpBuilder.post (ApiUrl.reblog client.server id) + |> HttpBuilder.withHeader "Authorization" ("Bearer " ++ client.token) + |> HttpBuilder.withExpect (Http.expectJson statusDecoder) + + +unreblog : Client -> Int -> Request Status +unreblog client id = + HttpBuilder.post (ApiUrl.unreblog client.server id) + |> HttpBuilder.withHeader "Authorization" ("Bearer " ++ client.token) + |> HttpBuilder.withExpect (Http.expectJson statusDecoder) + + +favourite : Client -> Int -> Request Status +favourite client id = + HttpBuilder.post (ApiUrl.favourite client.server id) + |> HttpBuilder.withHeader "Authorization" ("Bearer " ++ client.token) + |> HttpBuilder.withExpect (Http.expectJson statusDecoder) + + +unfavourite : Client -> Int -> Request Status +unfavourite client id = + HttpBuilder.post (ApiUrl.unfavourite client.server id) + |> HttpBuilder.withHeader "Authorization" ("Bearer " ++ client.token) + |> HttpBuilder.withExpect (Http.expectJson statusDecoder) diff --git a/src/Mastodon/Model.elm b/src/Mastodon/Model.elm new file mode 100644 index 0000000..da6c693 --- /dev/null +++ b/src/Mastodon/Model.elm @@ -0,0 +1,187 @@ +module Mastodon.Model + exposing + ( AccessTokenResult + , AppRegistration + , Account + , Attachment + , Client + , Error(..) + , Mention + , Notification + , NotificationAggregate + , Reblog(..) + , Tag + , Status + , StatusRequestBody + ) + +import HttpBuilder + + +type alias AccountId = + Int + + +type alias AuthCode = + String + + +type alias ClientId = + String + + +type alias ClientSecret = + String + + +type alias Server = + String + + +type alias StatusCode = + Int + + +type alias StatusMsg = + String + + +type alias Token = + String + + +type Error + = MastodonError StatusCode StatusMsg String + | ServerError StatusCode StatusMsg String + | TimeoutError + | NetworkError + + +type alias AccessTokenResult = + { server : Server + , accessToken : Token + } + + +type alias AppRegistration = + { server : Server + , scope : String + , client_id : ClientId + , client_secret : ClientSecret + , id : Int + , redirect_uri : String + } + + +type alias Account = + { acct : String + , avatar : String + , created_at : String + , display_name : String + , followers_count : Int + , following_count : Int + , header : String + , id : AccountId + , locked : Bool + , note : String + , statuses_count : Int + , url : String + , username : String + } + + +type alias Attachment = + -- type_: -- "image", "video", "gifv" + { id : Int + , type_ : String + , url : String + , remote_url : String + , preview_url : String + , text_url : Maybe String + } + + +type alias Client = + { server : Server + , token : Token + } + + +type alias Mention = + { id : AccountId + , url : String + , username : String + , acct : String + } + + +type alias Notification = + {- + - id: The notification ID + - type_: One of: "mention", "reblog", "favourite", "follow" + - created_at: The time the notification was created + - account: The Account sending the notification to the user + - status: The Status associated with the notification, if applicable + -} + { id : Int + , type_ : String + , created_at : String + , account : Account + , status : Maybe Status + } + + +type alias NotificationAggregate = + { type_ : String + , status : Maybe Status + , accounts : List Account + , created_at : String + } + + +type Reblog + = Reblog Status + + +type alias Status = + { account : Account + , content : String + , created_at : String + , favourited : Maybe Bool + , favourites_count : Int + , id : Int + , in_reply_to_account_id : Maybe Int + , in_reply_to_id : Maybe Int + , media_attachments : List Attachment + , mentions : List Mention + , reblog : Maybe Reblog + , reblogged : Maybe Bool + , reblogs_count : Int + , sensitive : Maybe Bool + , spoiler_text : String + , tags : List Tag + , uri : String + , url : String + , visibility : String + } + + +type alias StatusRequestBody = + -- status: The text of the status + -- in_reply_to_id: local ID of the status you want to reply to + -- sensitive: set this to mark the media of the status as NSFW + -- spoiler_text: text to be shown as a warning before the actual content + -- visibility: either "direct", "private", "unlisted" or "public" + -- TODO: media_ids: array of media IDs to attach to the status (maximum 4) + { status : String + , in_reply_to_id : Maybe Int + , spoiler_text : Maybe String + , sensitive : Bool + , visibility : String + } + + +type alias Tag = + { name : String + , url : String + } diff --git a/src/Mastodon/WebSocket.elm b/src/Mastodon/WebSocket.elm new file mode 100644 index 0000000..aac18a5 --- /dev/null +++ b/src/Mastodon/WebSocket.elm @@ -0,0 +1,62 @@ +module Mastodon.WebSocket + exposing + ( StreamType(..) + , WebSocketEvent(..) + , WebSocketMessage + , WebSocketPayload(..) + , subscribeToWebSockets + ) + +import String.Extra exposing (replaceSlice) +import WebSocket +import Mastodon.ApiUrl as ApiUrl +import Mastodon.Encoder exposing (encodeUrl) +import Mastodon.Model exposing (..) + + +type StreamType + = UserStream + | LocalPublicStream + | GlobalPublicStream + + +type WebSocketEvent + = StatusUpdateEvent (Result String Status) + | NotificationEvent (Result String Notification) + | StatusDeleteEvent (Result String Int) + | ErrorEvent String + + +type WebSocketPayload + = StringPayload String + | IntPayload Int + + +type alias WebSocketMessage = + { event : String + , payload : WebSocketPayload + } + + +subscribeToWebSockets : Client -> StreamType -> (String -> a) -> Sub a +subscribeToWebSockets client streamType message = + let + type_ = + case streamType of + GlobalPublicStream -> + "public" + + LocalPublicStream -> + "public:local" + + UserStream -> + "user" + + url = + encodeUrl + (ApiUrl.streaming (replaceSlice "wss" 0 5 client.server)) + [ ( "access_token", client.token ) + , ( "stream", type_ ) + ] + in + WebSocket.listen url message diff --git a/src/Model.elm b/src/Model.elm index 8b09912..acb67e6 100644 --- a/src/Model.elm +++ b/src/Model.elm @@ -3,14 +3,19 @@ module Model exposing (..) import Dom import Json.Encode as Encode import Navigation -import Mastodon +import Mastodon.Decoder +import Mastodon.Encoder +import Mastodon.Helper +import Mastodon.Http +import Mastodon.Model +import Mastodon.WebSocket import Ports import Task type alias Flags = - { client : Maybe Mastodon.Client - , registration : Maybe Mastodon.AppRegistration + { client : Maybe Mastodon.Model.Client + , registration : Maybe Mastodon.Model.AppRegistration } @@ -21,28 +26,28 @@ type DraftMsg | UpdateSpoiler String | UpdateStatus String | UpdateVisibility String - | UpdateReplyTo Mastodon.Status + | UpdateReplyTo Mastodon.Model.Status | ToggleSpoiler Bool type ViewerMsg = CloseViewer - | OpenViewer (List Mastodon.Attachment) Mastodon.Attachment + | OpenViewer (List Mastodon.Model.Attachment) Mastodon.Model.Attachment type MastodonMsg - = AccessToken (Result Mastodon.Error Mastodon.AccessTokenResult) - | AppRegistered (Result Mastodon.Error Mastodon.AppRegistration) - | FavoriteAdded (Result Mastodon.Error Mastodon.Status) - | FavoriteRemoved (Result Mastodon.Error Mastodon.Status) - | LocalTimeline (Result Mastodon.Error (List Mastodon.Status)) - | Notifications (Result Mastodon.Error (List Mastodon.Notification)) - | GlobalTimeline (Result Mastodon.Error (List Mastodon.Status)) - | Reblogged (Result Mastodon.Error Mastodon.Status) - | StatusPosted (Result Mastodon.Error Mastodon.Status) - | Unreblogged (Result Mastodon.Error Mastodon.Status) - | UserAccount (Result Mastodon.Error Mastodon.Account) - | UserTimeline (Result Mastodon.Error (List Mastodon.Status)) + = AccessToken (Result Mastodon.Model.Error Mastodon.Model.AccessTokenResult) + | AppRegistered (Result Mastodon.Model.Error Mastodon.Model.AppRegistration) + | FavoriteAdded (Result Mastodon.Model.Error Mastodon.Model.Status) + | FavoriteRemoved (Result Mastodon.Model.Error Mastodon.Model.Status) + | LocalTimeline (Result Mastodon.Model.Error (List Mastodon.Model.Status)) + | Notifications (Result Mastodon.Model.Error (List Mastodon.Model.Notification)) + | GlobalTimeline (Result Mastodon.Model.Error (List Mastodon.Model.Status)) + | Reblogged (Result Mastodon.Model.Error Mastodon.Model.Status) + | StatusPosted (Result Mastodon.Model.Error Mastodon.Model.Status) + | Unreblogged (Result Mastodon.Model.Error Mastodon.Model.Status) + | UserAccount (Result Mastodon.Model.Error Mastodon.Model.Account) + | UserTimeline (Result Mastodon.Model.Error (List Mastodon.Model.Status)) type WebSocketMsg @@ -72,7 +77,7 @@ type Msg type alias Draft = { status : String - , in_reply_to : Maybe Mastodon.Status + , in_reply_to : Maybe Mastodon.Model.Status , spoiler_text : Maybe String , sensitive : Bool , visibility : String @@ -80,21 +85,21 @@ type alias Draft = type alias Viewer = - { attachments : List Mastodon.Attachment - , attachment : Mastodon.Attachment + { attachments : List Mastodon.Model.Attachment + , attachment : Mastodon.Model.Attachment } type alias Model = { server : String - , registration : Maybe Mastodon.AppRegistration - , client : Maybe Mastodon.Client - , userTimeline : List Mastodon.Status - , localTimeline : List Mastodon.Status - , globalTimeline : List Mastodon.Status - , notifications : List Mastodon.NotificationAggregate + , registration : Maybe Mastodon.Model.AppRegistration + , client : Maybe Mastodon.Model.Client + , userTimeline : List Mastodon.Model.Status + , localTimeline : List Mastodon.Model.Status + , globalTimeline : List Mastodon.Model.Status + , notifications : List Mastodon.Model.NotificationAggregate , draft : Draft - , account : Maybe Mastodon.Account + , account : Maybe Mastodon.Model.Account , errors : List String , location : Navigation.Location , useGlobalTimeline : Bool @@ -145,15 +150,15 @@ init flags location = ! [ initCommands flags.registration flags.client authCode ] -initCommands : Maybe Mastodon.AppRegistration -> Maybe Mastodon.Client -> Maybe String -> Cmd Msg +initCommands : Maybe Mastodon.Model.AppRegistration -> Maybe Mastodon.Model.Client -> Maybe String -> Cmd Msg initCommands registration client authCode = Cmd.batch <| case authCode of Just authCode -> case registration of Just registration -> - [ Mastodon.getAccessToken registration authCode - |> Mastodon.send (MastodonEvent << AccessToken) + [ Mastodon.Http.getAccessToken registration authCode + |> Mastodon.Http.send (MastodonEvent << AccessToken) ] Nothing -> @@ -175,48 +180,51 @@ registerApp { server, location } = else server in - Mastodon.register + Mastodon.Http.register cleanServer "tooty" appUrl "read write follow" "https://github.com/n1k0/tooty" - |> Mastodon.send (MastodonEvent << AppRegistered) + |> Mastodon.Http.send (MastodonEvent << AppRegistered) -saveClient : Mastodon.Client -> Cmd Msg +saveClient : Mastodon.Model.Client -> Cmd Msg saveClient client = - Mastodon.clientEncoder client + Mastodon.Encoder.clientEncoder client |> Encode.encode 0 |> Ports.saveClient -saveRegistration : Mastodon.AppRegistration -> Cmd Msg +saveRegistration : Mastodon.Model.AppRegistration -> Cmd Msg saveRegistration registration = - Mastodon.registrationEncoder registration + Mastodon.Encoder.registrationEncoder registration |> Encode.encode 0 |> Ports.saveRegistration -loadNotifications : Maybe Mastodon.Client -> Cmd Msg +loadNotifications : Maybe Mastodon.Model.Client -> Cmd Msg loadNotifications client = case client of Just client -> - Mastodon.fetchNotifications client - |> Mastodon.send (MastodonEvent << Notifications) + Mastodon.Http.fetchNotifications client + |> Mastodon.Http.send (MastodonEvent << Notifications) Nothing -> Cmd.none -loadTimelines : Maybe Mastodon.Client -> Cmd Msg +loadTimelines : Maybe Mastodon.Model.Client -> Cmd Msg loadTimelines client = case client of Just client -> Cmd.batch - [ Mastodon.fetchUserTimeline client |> Mastodon.send (MastodonEvent << UserTimeline) - , Mastodon.fetchLocalTimeline client |> Mastodon.send (MastodonEvent << LocalTimeline) - , Mastodon.fetchGlobalTimeline client |> Mastodon.send (MastodonEvent << GlobalTimeline) + [ Mastodon.Http.fetchUserTimeline client + |> Mastodon.Http.send (MastodonEvent << UserTimeline) + , Mastodon.Http.fetchLocalTimeline client + |> Mastodon.Http.send (MastodonEvent << LocalTimeline) + , Mastodon.Http.fetchGlobalTimeline client + |> Mastodon.Http.send (MastodonEvent << GlobalTimeline) , loadNotifications <| Just client ] @@ -224,29 +232,29 @@ loadTimelines client = Cmd.none -postStatus : Mastodon.Client -> Mastodon.StatusRequestBody -> Cmd Msg +postStatus : Mastodon.Model.Client -> Mastodon.Model.StatusRequestBody -> Cmd Msg postStatus client draft = - Mastodon.postStatus client draft - |> Mastodon.send (MastodonEvent << StatusPosted) + Mastodon.Http.postStatus client draft + |> Mastodon.Http.send (MastodonEvent << StatusPosted) -errorText : Mastodon.Error -> String +errorText : Mastodon.Model.Error -> String errorText error = case error of - Mastodon.MastodonError statusCode statusMsg errorMsg -> + Mastodon.Model.MastodonError statusCode statusMsg errorMsg -> "HTTP " ++ (toString statusCode) ++ " " ++ statusMsg ++ ": " ++ errorMsg - Mastodon.ServerError statusCode statusMsg errorMsg -> + Mastodon.Model.ServerError statusCode statusMsg errorMsg -> "HTTP " ++ (toString statusCode) ++ " " ++ statusMsg ++ ": " ++ errorMsg - Mastodon.TimeoutError -> + Mastodon.Model.TimeoutError -> "Request timed out." - Mastodon.NetworkError -> + Mastodon.Model.NetworkError -> "Unreachable host." -toStatusRequestBody : Draft -> Mastodon.StatusRequestBody +toStatusRequestBody : Draft -> Mastodon.Model.StatusRequestBody toStatusRequestBody draft = { status = draft.status , in_reply_to_id = @@ -262,11 +270,11 @@ toStatusRequestBody draft = } -updateTimelinesWithBoolFlag : Int -> Bool -> (Mastodon.Status -> Mastodon.Status) -> Model -> Model +updateTimelinesWithBoolFlag : Int -> Bool -> (Mastodon.Model.Status -> Mastodon.Model.Status) -> Model -> Model updateTimelinesWithBoolFlag statusId flag statusUpdater model = let update flag status = - if (Mastodon.extractReblog status).id == statusId then + if (Mastodon.Helper.extractReblog status).id == statusId then statusUpdater status else status @@ -288,10 +296,16 @@ processReblog statusId flag model = updateTimelinesWithBoolFlag statusId flag (\s -> { s | reblogged = Just flag }) model -deleteStatusFromTimeline : Int -> List Mastodon.Status -> List Mastodon.Status +deleteStatusFromTimeline : Int -> List Mastodon.Model.Status -> List Mastodon.Model.Status deleteStatusFromTimeline statusId timeline = timeline - |> List.filter (\s -> s.id /= statusId && (Mastodon.extractReblog s).id /= statusId) + |> List.filter + (\s -> + s.id + /= statusId + && (Mastodon.Helper.extractReblog s).id + /= statusId + ) updateDraft : DraftMsg -> Draft -> ( Draft, Cmd Msg ) @@ -366,7 +380,7 @@ processMastodonEvent msg model = Ok { server, accessToken } -> let client = - Mastodon.Client server accessToken + Mastodon.Model.Client server accessToken in { model | client = Just client } ! [ loadTimelines <| Just client @@ -382,7 +396,7 @@ processMastodonEvent msg model = Ok registration -> { model | registration = Just registration } ! [ saveRegistration registration - , Navigation.load <| Mastodon.getAuthorizationUrl registration + , Navigation.load <| Mastodon.Http.getAuthorizationUrl registration ] Err error -> @@ -415,7 +429,7 @@ processMastodonEvent msg model = Notifications result -> case result of Ok notifications -> - { model | notifications = Mastodon.aggregateNotifications notifications } ! [] + { model | notifications = Mastodon.Helper.aggregateNotifications notifications } ! [] Err error -> { model | notifications = [], errors = (errorText error) :: model.errors } ! [] @@ -468,11 +482,11 @@ processWebSocketMsg : WebSocketMsg -> Model -> ( Model, Cmd Msg ) processWebSocketMsg msg model = case msg of NewWebsocketUserMessage message -> - case (Mastodon.decodeWebSocketMessage message) of - Mastodon.ErrorEvent error -> + case (Mastodon.Decoder.decodeWebSocketMessage message) of + Mastodon.WebSocket.ErrorEvent error -> { model | errors = error :: model.errors } ! [] - Mastodon.StatusUpdateEvent result -> + Mastodon.WebSocket.StatusUpdateEvent result -> case result of Ok status -> { model | userTimeline = status :: model.userTimeline } ! [] @@ -480,7 +494,7 @@ processWebSocketMsg msg model = Err error -> { model | errors = error :: model.errors } ! [] - Mastodon.StatusDeleteEvent result -> + Mastodon.WebSocket.StatusDeleteEvent result -> case result of Ok id -> { model | userTimeline = deleteStatusFromTimeline id model.userTimeline } ! [] @@ -488,12 +502,14 @@ processWebSocketMsg msg model = Err error -> { model | errors = error :: model.errors } ! [] - Mastodon.NotificationEvent result -> + Mastodon.WebSocket.NotificationEvent result -> case result of Ok notification -> let notifications = - Mastodon.addNotificationToAggregates notification model.notifications + Mastodon.Helper.addNotificationToAggregates + notification + model.notifications in { model | notifications = notifications } ! [] @@ -501,11 +517,11 @@ processWebSocketMsg msg model = { model | errors = error :: model.errors } ! [] NewWebsocketLocalMessage message -> - case (Mastodon.decodeWebSocketMessage message) of - Mastodon.ErrorEvent error -> + case (Mastodon.Decoder.decodeWebSocketMessage message) of + Mastodon.WebSocket.ErrorEvent error -> { model | errors = error :: model.errors } ! [] - Mastodon.StatusUpdateEvent result -> + Mastodon.WebSocket.StatusUpdateEvent result -> case result of Ok status -> { model | localTimeline = status :: model.localTimeline } ! [] @@ -513,7 +529,7 @@ processWebSocketMsg msg model = Err error -> { model | errors = error :: model.errors } ! [] - Mastodon.StatusDeleteEvent result -> + Mastodon.WebSocket.StatusDeleteEvent result -> case result of Ok id -> { model | localTimeline = deleteStatusFromTimeline id model.localTimeline } ! [] @@ -525,11 +541,11 @@ processWebSocketMsg msg model = model ! [] NewWebsocketGlobalMessage message -> - case (Mastodon.decodeWebSocketMessage message) of - Mastodon.ErrorEvent error -> + case (Mastodon.Decoder.decodeWebSocketMessage message) of + Mastodon.WebSocket.ErrorEvent error -> { model | errors = error :: model.errors } ! [] - Mastodon.StatusUpdateEvent result -> + Mastodon.WebSocket.StatusUpdateEvent result -> case result of Ok status -> { model | globalTimeline = status :: model.globalTimeline } ! [] @@ -537,7 +553,7 @@ processWebSocketMsg msg model = Err error -> { model | errors = error :: model.errors } ! [] - Mastodon.StatusDeleteEvent result -> + Mastodon.WebSocket.StatusDeleteEvent result -> case result of Ok id -> { model | globalTimeline = deleteStatusFromTimeline id model.globalTimeline } ! [] @@ -585,8 +601,8 @@ update msg model = case model.client of Just client -> processReblog id True model - ! [ Mastodon.reblog client id - |> Mastodon.send (MastodonEvent << Reblogged) + ! [ Mastodon.Http.reblog client id + |> Mastodon.Http.send (MastodonEvent << Reblogged) ] Nothing -> @@ -596,8 +612,8 @@ update msg model = case model.client of Just client -> processReblog id False model - ! [ Mastodon.unfavourite client id - |> Mastodon.send (MastodonEvent << Unreblogged) + ! [ Mastodon.Http.unfavourite client id + |> Mastodon.Http.send (MastodonEvent << Unreblogged) ] Nothing -> @@ -607,8 +623,8 @@ update msg model = model ! case model.client of Just client -> - [ Mastodon.favourite client id - |> Mastodon.send (MastodonEvent << FavoriteAdded) + [ Mastodon.Http.favourite client id + |> Mastodon.Http.send (MastodonEvent << FavoriteAdded) ] Nothing -> @@ -618,8 +634,8 @@ update msg model = model ! case model.client of Just client -> - [ Mastodon.unfavourite client id - |> Mastodon.send (MastodonEvent << FavoriteRemoved) + [ Mastodon.Http.unfavourite client id + |> Mastodon.Http.send (MastodonEvent << FavoriteRemoved) ] Nothing -> @@ -657,8 +673,8 @@ update msg model = model ! case model.client of Just client -> - [ Mastodon.fetchAccount client accountId - |> Mastodon.send (MastodonEvent << UserAccount) + [ Mastodon.Http.fetchAccount client accountId + |> Mastodon.Http.send (MastodonEvent << UserAccount) ] Nothing -> @@ -677,21 +693,21 @@ subscriptions model = Just client -> let subs = - [ Mastodon.subscribeToWebSockets + [ Mastodon.WebSocket.subscribeToWebSockets client - Mastodon.UserStream + Mastodon.WebSocket.UserStream NewWebsocketUserMessage ] ++ (if model.useGlobalTimeline then - [ Mastodon.subscribeToWebSockets + [ Mastodon.WebSocket.subscribeToWebSockets client - Mastodon.GlobalPublicStream + Mastodon.WebSocket.GlobalPublicStream NewWebsocketGlobalMessage ] else - [ Mastodon.subscribeToWebSockets + [ Mastodon.WebSocket.subscribeToWebSockets client - Mastodon.LocalPublicStream + Mastodon.WebSocket.LocalPublicStream NewWebsocketLocalMessage ] ) diff --git a/src/Util.elm b/src/Util.elm deleted file mode 100644 index d1fd0f8..0000000 --- a/src/Util.elm +++ /dev/null @@ -1,6 +0,0 @@ -module Util exposing (..) - - -replace : String -> String -> String -> String -replace from to str = - String.split from str |> String.join to diff --git a/src/View.elm b/src/View.elm index 78e43df..ac526a7 100644 --- a/src/View.elm +++ b/src/View.elm @@ -5,7 +5,8 @@ import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) import List.Extra exposing (elemIndex, getAt) -import Mastodon +import Mastodon.Helper +import Mastodon.Model import Model exposing (Model, Draft, DraftMsg(..), Viewer, ViewerMsg(..), Msg(..)) import ViewHelper import Date @@ -49,7 +50,7 @@ icon name = i [ class <| "glyphicon glyphicon-" ++ name ] [] -accountLink : Mastodon.Account -> Html Msg +accountLink : Mastodon.Model.Account -> Html Msg accountLink account = a [ href account.url @@ -58,7 +59,7 @@ accountLink account = [ text <| "@" ++ account.username ] -accountAvatarLink : Mastodon.Account -> Html Msg +accountAvatarLink : Mastodon.Model.Account -> Html Msg accountAvatarLink account = a [ href account.url @@ -68,7 +69,7 @@ accountAvatarLink account = [ img [ class "avatar", src account.avatar ] [] ] -attachmentPreview : String -> Maybe Bool -> List Mastodon.Attachment -> Mastodon.Attachment -> Html Msg +attachmentPreview : String -> Maybe Bool -> List Mastodon.Model.Attachment -> Mastodon.Model.Attachment -> Html Msg attachmentPreview context sensitive attachments ({ url, preview_url } as attachment) = let nsfw = @@ -111,7 +112,7 @@ attachmentPreview context sensitive attachments ({ url, preview_url } as attachm [ media ] -attachmentListView : String -> Mastodon.Status -> Html Msg +attachmentListView : String -> Mastodon.Model.Status -> Html Msg attachmentListView context { media_attachments, sensitive } = case media_attachments of [] -> @@ -122,7 +123,7 @@ attachmentListView context { media_attachments, sensitive } = List.map (attachmentPreview context sensitive attachments) attachments -statusContentView : String -> Mastodon.Status -> Html Msg +statusContentView : String -> Mastodon.Model.Status -> Html Msg statusContentView context status = case status.spoiler_text of "" -> @@ -148,19 +149,20 @@ statusContentView context status = ] -statusView : String -> Mastodon.Status -> Html Msg +statusView : String -> Mastodon.Model.Status -> Html Msg statusView context ({ account, content, media_attachments, reblog, mentions } as status) = let accountLinkAttributes = [ href account.url - -- When clicking on a status, we should not let the browser - -- redirect to a new page. That's why we're preventing the default - -- behavior here + + -- When clicking on a status, we should not let the browser + -- redirect to a new page. That's why we're preventing the default + -- behavior here , ViewHelper.onClickWithPreventAndStop (OnLoadUserAccount account.id) ] in case reblog of - Just (Mastodon.Reblog reblog) -> + Just (Mastodon.Model.Reblog reblog) -> div [ class "reblog" ] [ p [ class "status-info" ] [ icon "fire" @@ -184,7 +186,7 @@ statusView context ({ account, content, media_attachments, reblog, mentions } as ] -accountTimelineView : Mastodon.Account -> List Mastodon.Status -> String -> String -> Html Msg +accountTimelineView : Mastodon.Model.Account -> List Mastodon.Model.Status -> String -> String -> Html Msg accountTimelineView account statuses label iconName = div [ class "col-md-3" ] [ div [ class "panel panel-default" ] @@ -236,11 +238,11 @@ accountTimelineView account statuses label iconName = ] -statusActionsView : Mastodon.Status -> Html Msg +statusActionsView : Mastodon.Model.Status -> Html Msg statusActionsView status = let targetStatus = - Mastodon.extractReblog status + Mastodon.Helper.extractReblog status baseBtnClasses = "btn btn-sm btn-default" @@ -294,7 +296,7 @@ statusActionsView status = ] -statusEntryView : String -> Mastodon.Status -> Html Msg +statusEntryView : String -> Mastodon.Model.Status -> Html Msg statusEntryView context status = let nsfwClass = @@ -311,7 +313,7 @@ statusEntryView context status = ] -timelineView : String -> String -> String -> List Mastodon.Status -> Html Msg +timelineView : String -> String -> String -> List Mastodon.Model.Status -> Html Msg timelineView label iconName context statuses = div [ class "col-md-3" ] [ div [ class "panel panel-default" ] @@ -325,7 +327,7 @@ timelineView label iconName context statuses = ] -notificationHeading : List Mastodon.Account -> String -> String -> Html Msg +notificationHeading : List Mastodon.Model.Account -> String -> String -> Html Msg notificationHeading accounts str iconType = div [ class "status-info" ] [ div [ class "avatars" ] <| List.map accountAvatarLink accounts @@ -338,7 +340,7 @@ notificationHeading accounts str iconType = ] -notificationStatusView : String -> Mastodon.Status -> Mastodon.NotificationAggregate -> Html Msg +notificationStatusView : String -> Mastodon.Model.Status -> Mastodon.Model.NotificationAggregate -> Html Msg notificationStatusView context status { type_, accounts } = div [ class <| "notification " ++ type_ ] [ case type_ of @@ -355,7 +357,7 @@ notificationStatusView context status { type_, accounts } = ] -notificationFollowView : Mastodon.NotificationAggregate -> Html Msg +notificationFollowView : Mastodon.Model.NotificationAggregate -> Html Msg notificationFollowView { accounts } = let profileView account = @@ -371,7 +373,7 @@ notificationFollowView { accounts } = ] -notificationEntryView : Mastodon.NotificationAggregate -> Html Msg +notificationEntryView : Mastodon.Model.NotificationAggregate -> Html Msg notificationEntryView notification = li [ class "list-group-item" ] [ case notification.status of @@ -383,7 +385,7 @@ notificationEntryView notification = ] -notificationListView : List Mastodon.NotificationAggregate -> Html Msg +notificationListView : List Mastodon.Model.NotificationAggregate -> Html Msg notificationListView notifications = div [ class "col-md-3" ] [ div [ class "panel panel-default" ] diff --git a/src/ViewHelper.elm b/src/ViewHelper.elm index cb3538d..362417e 100644 --- a/src/ViewHelper.elm +++ b/src/ViewHelper.elm @@ -11,9 +11,9 @@ import Html.Attributes exposing (..) import Html.Events exposing (onWithOptions) import HtmlParser import Json.Decode as Decode -import Mastodon +import String.Extra exposing (replace) +import Mastodon.Model import Model exposing (Msg(OnLoadUserAccount)) -import Util -- Custom Events @@ -31,24 +31,24 @@ onClickWithPreventAndStop msg = -- Views -formatContent : String -> List Mastodon.Mention -> List (Html Msg) +formatContent : String -> List Mastodon.Model.Mention -> List (Html Msg) formatContent content mentions = content - |> Util.replace " ?" " ?" - |> Util.replace " !" " !" - |> Util.replace " :" " :" + |> replace " ?" " ?" + |> replace " !" " !" + |> replace " :" " :" |> HtmlParser.parse |> toVirtualDom mentions {-| Converts nodes to virtual dom nodes. -} -toVirtualDom : List Mastodon.Mention -> List HtmlParser.Node -> List (Html Msg) +toVirtualDom : List Mastodon.Model.Mention -> List HtmlParser.Node -> List (Html Msg) toVirtualDom mentions nodes = List.map (toVirtualDomEach mentions) nodes -createLinkNode : List ( String, String ) -> List HtmlParser.Node -> List Mastodon.Mention -> Html Msg +createLinkNode : List ( String, String ) -> List HtmlParser.Node -> List Mastodon.Model.Mention -> Html Msg createLinkNode attrs children mentions = let maybeMention = @@ -76,7 +76,7 @@ getHrefLink attrs = |> List.head -getMentionForLink : List ( String, String ) -> List Mastodon.Mention -> Maybe Mastodon.Mention +getMentionForLink : List ( String, String ) -> List Mastodon.Model.Mention -> Maybe Mastodon.Model.Mention getMentionForLink attrs mentions = case getHrefLink attrs of Just href -> @@ -88,7 +88,7 @@ getMentionForLink attrs mentions = Nothing -toVirtualDomEach : List Mastodon.Mention -> HtmlParser.Node -> Html Msg +toVirtualDomEach : List Mastodon.Model.Mention -> HtmlParser.Node -> Html Msg toVirtualDomEach mentions node = case node of HtmlParser.Element "a" attrs children -> diff --git a/tests/Fixtures.elm b/tests/Fixtures.elm index 5f2e611..b18eaf9 100644 --- a/tests/Fixtures.elm +++ b/tests/Fixtures.elm @@ -1,6 +1,6 @@ module Fixtures exposing (..) -import Mastodon exposing (Account, Notification, NotificationAggregate, Status) +import Mastodon.Model exposing (Account, Notification, NotificationAggregate, Status) accountSkro : Account diff --git a/tests/Main.elm b/tests/Main.elm index ddb9070..613fae9 100644 --- a/tests/Main.elm +++ b/tests/Main.elm @@ -1,13 +1,13 @@ port module Main exposing (..) -import NotificationTests +import MastodonTest.HelperTest import Test.Runner.Node exposing (run, TestProgram) import Json.Encode exposing (Value) main : TestProgram main = - run emit NotificationTests.all + run emit MastodonTest.HelperTest.all port emit : ( String, Value ) -> Cmd msg diff --git a/tests/NotificationTests.elm b/tests/MastodonTest/HelperTest.elm similarity index 84% rename from tests/NotificationTests.elm rename to tests/MastodonTest/HelperTest.elm index aed7c55..6b1efcc 100644 --- a/tests/NotificationTests.elm +++ b/tests/MastodonTest/HelperTest.elm @@ -1,9 +1,8 @@ -module NotificationTests exposing (..) +module MastodonTest.HelperTest exposing (..) import Test exposing (..) import Expect -import String -import Mastodon +import Mastodon.Helper import Fixtures @@ -14,7 +13,7 @@ all = [ test "Aggregate Notifications" <| \() -> Fixtures.notifications - |> Mastodon.aggregateNotifications + |> Mastodon.Helper.aggregateNotifications |> Expect.equal [ { type_ = "mention" , status = Just Fixtures.statusNicoToVjousse @@ -30,8 +29,8 @@ all = , test "Add follows notification to aggregate" <| \() -> Fixtures.notifications - |> Mastodon.aggregateNotifications - |> (Mastodon.addNotificationToAggregates Fixtures.notificationPloumFollowsVjousse) + |> Mastodon.Helper.aggregateNotifications + |> (Mastodon.Helper.addNotificationToAggregates Fixtures.notificationPloumFollowsVjousse) |> Expect.equal [ { type_ = "mention" , status = Just Fixtures.statusNicoToVjousse @@ -47,8 +46,8 @@ all = , test "Add mention notification to aggregate" <| \() -> Fixtures.notifications - |> Mastodon.aggregateNotifications - |> (Mastodon.addNotificationToAggregates Fixtures.notificationNicoMentionVjousse) + |> Mastodon.Helper.aggregateNotifications + |> (Mastodon.Helper.addNotificationToAggregates Fixtures.notificationNicoMentionVjousse) |> Expect.equal [ { type_ = "mention" , status = Just Fixtures.statusNicoToVjousse @@ -64,8 +63,8 @@ all = , test "Add new mention notification to aggregate" <| \() -> Fixtures.notifications - |> Mastodon.aggregateNotifications - |> (Mastodon.addNotificationToAggregates Fixtures.notificationNicoMentionVjousseAgain) + |> Mastodon.Helper.aggregateNotifications + |> (Mastodon.Helper.addNotificationToAggregates Fixtures.notificationNicoMentionVjousseAgain) |> Expect.equal [ { type_ = "mention" , status = Just Fixtures.statusNicoToVjousseAgain diff --git a/tests/elm-package.json b/tests/elm-package.json index 274d653..7465143 100644 --- a/tests/elm-package.json +++ b/tests/elm-package.json @@ -18,6 +18,7 @@ "NoRedInk/elm-decode-pipeline": "3.0.0 <= v < 4.0.0", "elm-community/list-extra": "6.0.0 <= v < 7.0.0", + "elm-community/string-extra": "1.3.3 <= v < 2.0.0", "elm-lang/core": "5.1.1 <= v < 6.0.0", "elm-lang/dom": "1.1.1 <= v < 2.0.0", "elm-lang/html": "2.0.0 <= v < 3.0.0",