2017-04-20 07:33:32 +00:00
|
|
|
module Mastodon
|
|
|
|
exposing
|
|
|
|
( AccessTokenResult
|
|
|
|
, Account
|
|
|
|
, AppRegistration
|
|
|
|
, Attachment
|
|
|
|
, Client
|
|
|
|
, Error(..)
|
|
|
|
, Mention
|
2017-04-22 14:39:19 +00:00
|
|
|
, Notification
|
2017-04-23 19:49:04 +00:00
|
|
|
, NotificationAggregate
|
2017-04-20 07:33:32 +00:00
|
|
|
, Reblog(..)
|
|
|
|
, Status
|
2017-04-20 18:30:19 +00:00
|
|
|
, StatusRequestBody
|
2017-04-25 14:27:15 +00:00
|
|
|
, StreamType(..)
|
2017-04-20 07:33:32 +00:00
|
|
|
, Tag
|
2017-04-27 06:11:24 +00:00
|
|
|
, WebSocketEvent(..)
|
2017-04-23 08:18:47 +00:00
|
|
|
, reblog
|
|
|
|
, unreblog
|
|
|
|
, favourite
|
|
|
|
, unfavourite
|
|
|
|
, extractReblog
|
2017-04-20 07:33:32 +00:00
|
|
|
, register
|
|
|
|
, registrationEncoder
|
2017-04-23 19:49:04 +00:00
|
|
|
, aggregateNotifications
|
2017-04-20 07:33:32 +00:00
|
|
|
, clientEncoder
|
2017-04-25 14:27:15 +00:00
|
|
|
, decodeWebSocketMessage
|
2017-04-20 07:33:32 +00:00
|
|
|
, getAuthorizationUrl
|
|
|
|
, getAccessToken
|
2017-04-22 08:16:14 +00:00
|
|
|
, fetchAccount
|
2017-04-20 07:33:32 +00:00
|
|
|
, fetchLocalTimeline
|
2017-04-22 14:39:19 +00:00
|
|
|
, fetchNotifications
|
2017-04-25 21:33:37 +00:00
|
|
|
, fetchGlobalTimeline
|
2017-04-20 07:33:32 +00:00
|
|
|
, fetchUserTimeline
|
2017-04-20 18:30:19 +00:00
|
|
|
, postStatus
|
2017-04-20 07:33:32 +00:00
|
|
|
, send
|
2017-04-25 14:27:15 +00:00
|
|
|
, subscribeToWebSockets
|
|
|
|
, notificationDecoder
|
|
|
|
, addNotificationToAggregates
|
|
|
|
, notificationToAggregate
|
2017-04-20 07:33:32 +00:00
|
|
|
)
|
|
|
|
|
|
|
|
import Http
|
|
|
|
import HttpBuilder
|
|
|
|
import Json.Decode.Pipeline as Pipe
|
|
|
|
import Json.Decode as Decode
|
|
|
|
import Json.Encode as Encode
|
2017-04-25 14:27:15 +00:00
|
|
|
import Util
|
|
|
|
import WebSocket
|
2017-04-23 19:49:04 +00:00
|
|
|
import List.Extra exposing (groupWhile)
|
2017-04-26 15:07:43 +00:00
|
|
|
import Mastodon.ApiUrl as ApiUrl
|
2017-04-20 07:33:32 +00:00
|
|
|
|
|
|
|
|
|
|
|
-- Types
|
|
|
|
|
|
|
|
|
2017-04-22 08:16:14 +00:00
|
|
|
type alias AccountId =
|
|
|
|
Int
|
2017-04-20 07:33:32 +00:00
|
|
|
|
|
|
|
|
|
|
|
type alias AuthCode =
|
|
|
|
String
|
|
|
|
|
|
|
|
|
|
|
|
type alias ClientId =
|
|
|
|
String
|
|
|
|
|
|
|
|
|
|
|
|
type alias ClientSecret =
|
|
|
|
String
|
|
|
|
|
|
|
|
|
2017-04-22 08:16:14 +00:00
|
|
|
type alias Server =
|
|
|
|
String
|
|
|
|
|
|
|
|
|
2017-04-20 07:33:32 +00:00
|
|
|
type alias StatusCode =
|
|
|
|
Int
|
|
|
|
|
|
|
|
|
|
|
|
type alias StatusMsg =
|
|
|
|
String
|
|
|
|
|
|
|
|
|
|
|
|
type alias Token =
|
|
|
|
String
|
|
|
|
|
|
|
|
|
|
|
|
type Error
|
|
|
|
= MastodonError StatusCode StatusMsg String
|
|
|
|
| ServerError StatusCode StatusMsg String
|
|
|
|
| TimeoutError
|
|
|
|
| NetworkError
|
|
|
|
|
|
|
|
|
2017-04-27 06:11:24 +00:00
|
|
|
type alias AccessTokenResult =
|
|
|
|
{ server : Server
|
|
|
|
, accessToken : Token
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
type alias Client =
|
|
|
|
{ server : Server
|
|
|
|
, token : Token
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2017-04-20 07:33:32 +00:00
|
|
|
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
|
2017-04-22 08:16:14 +00:00
|
|
|
, id : AccountId
|
2017-04-20 07:33:32 +00:00
|
|
|
, locked : Bool
|
|
|
|
, note : String
|
|
|
|
, statuses_count : Int
|
|
|
|
, url : String
|
|
|
|
, username : String
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
type alias Attachment =
|
2017-04-20 18:30:19 +00:00
|
|
|
-- type_: -- "image", "video", "gifv"
|
2017-04-20 07:33:32 +00:00
|
|
|
{ id : Int
|
2017-04-20 18:30:19 +00:00
|
|
|
, type_ : String
|
2017-04-20 07:33:32 +00:00
|
|
|
, url : String
|
|
|
|
, remote_url : String
|
|
|
|
, preview_url : String
|
|
|
|
, text_url : Maybe String
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
type alias Mention =
|
2017-04-22 08:16:14 +00:00
|
|
|
{ id : AccountId
|
2017-04-20 07:33:32 +00:00
|
|
|
, url : String
|
|
|
|
, username : String
|
|
|
|
, acct : String
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2017-04-22 14:39:19 +00:00
|
|
|
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
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2017-04-23 19:49:04 +00:00
|
|
|
type alias NotificationAggregate =
|
|
|
|
{ type_ : String
|
|
|
|
, status : Maybe Status
|
|
|
|
, accounts : List Account
|
|
|
|
, created_at : String
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2017-04-20 07:33:32 +00:00
|
|
|
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
|
|
|
|
|
|
|
|
|
2017-04-20 18:30:19 +00:00
|
|
|
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
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2017-04-20 20:55:08 +00:00
|
|
|
type alias Request a =
|
|
|
|
HttpBuilder.RequestBuilder a
|
|
|
|
|
|
|
|
|
2017-04-25 14:27:15 +00:00
|
|
|
type StreamType
|
|
|
|
= UserStream
|
|
|
|
| LocalPublicStream
|
|
|
|
| GlobalPublicStream
|
|
|
|
|
|
|
|
|
2017-04-27 06:11:24 +00:00
|
|
|
type WebSocketEvent
|
|
|
|
= StatusUpdateEvent (Result String Status)
|
|
|
|
| NotificationEvent (Result String Notification)
|
|
|
|
| StatusDeleteEvent (Result String Int)
|
|
|
|
| ErrorEvent String
|
2017-04-20 07:33:32 +00:00
|
|
|
|
|
|
|
|
2017-04-27 06:11:24 +00:00
|
|
|
type WebSocketPayload
|
|
|
|
= StringPayload String
|
|
|
|
| IntPayload Int
|
2017-04-20 07:33:32 +00:00
|
|
|
|
|
|
|
|
2017-04-27 06:11:24 +00:00
|
|
|
type alias WebSocketMessage =
|
|
|
|
{ event : String
|
|
|
|
, payload : WebSocketPayload
|
2017-04-20 07:33:32 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
-- Encoders
|
|
|
|
|
|
|
|
|
2017-04-20 17:12:23 +00:00
|
|
|
appRegistrationEncoder : String -> String -> String -> String -> Encode.Value
|
|
|
|
appRegistrationEncoder client_name redirect_uris scope website =
|
2017-04-20 07:33:32 +00:00
|
|
|
Encode.object
|
|
|
|
[ ( "client_name", Encode.string client_name )
|
|
|
|
, ( "redirect_uris", Encode.string redirect_uris )
|
|
|
|
, ( "scopes", Encode.string scope )
|
2017-04-20 17:12:23 +00:00
|
|
|
, ( "website", Encode.string website )
|
2017-04-20 07:33:32 +00:00
|
|
|
]
|
|
|
|
|
|
|
|
|
|
|
|
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 )
|
|
|
|
]
|
|
|
|
|
|
|
|
|
2017-04-20 18:30:19 +00:00
|
|
|
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 )
|
|
|
|
]
|
|
|
|
|
|
|
|
|
2017-04-20 07:33:32 +00:00
|
|
|
|
|
|
|
-- 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
|
|
|
|
|
|
|
|
|
2017-04-22 14:39:19 +00:00
|
|
|
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
|
|
|
|
|
|
|
|
|
2017-04-20 07:33:32 +00:00
|
|
|
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
|
|
|
|
|
|
|
|
|
2017-04-27 06:11:24 +00:00
|
|
|
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
|
2017-04-25 14:27:15 +00:00
|
|
|
|> Pipe.required "event" Decode.string
|
2017-04-27 06:11:24 +00:00
|
|
|
|> Pipe.required "payload" webSocketPayloadDecoder
|
2017-04-25 14:27:15 +00:00
|
|
|
|
|
|
|
|
2017-04-20 07:33:32 +00:00
|
|
|
|
|
|
|
-- Internal helpers
|
|
|
|
|
|
|
|
|
2017-04-20 18:30:19 +00:00
|
|
|
encodeMaybe : (a -> Encode.Value) -> Maybe a -> Encode.Value
|
|
|
|
encodeMaybe encode thing =
|
|
|
|
case thing of
|
|
|
|
Nothing ->
|
|
|
|
Encode.null
|
|
|
|
|
|
|
|
Just value ->
|
|
|
|
encode value
|
|
|
|
|
|
|
|
|
2017-04-20 07:33:32 +00:00
|
|
|
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
|
|
|
|
|
|
|
|
|
2017-04-23 08:18:47 +00:00
|
|
|
extractReblog : Status -> Status
|
|
|
|
extractReblog status =
|
|
|
|
case status.reblog of
|
|
|
|
Just (Reblog reblog) ->
|
|
|
|
reblog
|
|
|
|
|
|
|
|
Nothing ->
|
|
|
|
status
|
|
|
|
|
|
|
|
|
2017-04-20 07:33:32 +00:00
|
|
|
toResponse : Result Http.Error a -> Result Error a
|
|
|
|
toResponse result =
|
|
|
|
Result.mapError extractError result
|
|
|
|
|
|
|
|
|
2017-04-20 20:55:08 +00:00
|
|
|
fetch : Client -> String -> Decode.Decoder a -> Request a
|
2017-04-20 19:33:17 +00:00
|
|
|
fetch client endpoint decoder =
|
2017-04-20 07:33:32 +00:00
|
|
|
HttpBuilder.get (client.server ++ endpoint)
|
|
|
|
|> HttpBuilder.withHeader "Authorization" ("Bearer " ++ client.token)
|
2017-04-20 19:33:17 +00:00
|
|
|
|> HttpBuilder.withExpect (Http.expectJson decoder)
|
2017-04-20 07:33:32 +00:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
-- Public API
|
|
|
|
|
|
|
|
|
2017-04-25 14:27:15 +00:00
|
|
|
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
|
|
|
|
|
|
|
|
|
2017-04-23 19:49:04 +00:00
|
|
|
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
|
2017-04-24 09:46:14 +00:00
|
|
|
, notifications |> only "follow" |> groupWhile (\_ _ -> True) |> aggregate
|
2017-04-23 19:49:04 +00:00
|
|
|
]
|
|
|
|
|> List.concat
|
|
|
|
|> List.sortBy .created_at
|
|
|
|
|> List.reverse
|
|
|
|
|
|
|
|
|
2017-04-20 07:33:32 +00:00
|
|
|
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 )
|
|
|
|
]
|
|
|
|
|
|
|
|
|
2017-04-20 20:55:08 +00:00
|
|
|
register : Server -> String -> String -> String -> String -> Request AppRegistration
|
2017-04-20 17:12:23 +00:00
|
|
|
register server client_name redirect_uri scope website =
|
2017-04-26 15:07:43 +00:00
|
|
|
HttpBuilder.post (ApiUrl.apps server)
|
2017-04-20 07:33:32 +00:00
|
|
|
|> HttpBuilder.withExpect (Http.expectJson (appRegistrationDecoder server scope))
|
2017-04-20 17:12:23 +00:00
|
|
|
|> HttpBuilder.withJsonBody (appRegistrationEncoder client_name redirect_uri scope website)
|
2017-04-20 07:33:32 +00:00
|
|
|
|
|
|
|
|
|
|
|
getAuthorizationUrl : AppRegistration -> String
|
|
|
|
getAuthorizationUrl registration =
|
2017-04-26 15:07:43 +00:00
|
|
|
encodeUrl (ApiUrl.oauthAuthorize registration.server)
|
2017-04-20 07:33:32 +00:00
|
|
|
[ ( "response_type", "code" )
|
|
|
|
, ( "client_id", registration.client_id )
|
|
|
|
, ( "scope", registration.scope )
|
|
|
|
, ( "redirect_uri", registration.redirect_uri )
|
|
|
|
]
|
|
|
|
|
|
|
|
|
2017-04-20 20:55:08 +00:00
|
|
|
getAccessToken : AppRegistration -> AuthCode -> Request AccessTokenResult
|
2017-04-20 07:33:32 +00:00
|
|
|
getAccessToken registration authCode =
|
2017-04-26 15:07:43 +00:00
|
|
|
HttpBuilder.post (ApiUrl.oauthToken registration.server)
|
2017-04-20 07:33:32 +00:00
|
|
|
|> HttpBuilder.withExpect (Http.expectJson (accessTokenDecoder registration))
|
|
|
|
|> HttpBuilder.withJsonBody (authorizationCodeEncoder registration authCode)
|
|
|
|
|
|
|
|
|
2017-04-20 20:55:08 +00:00
|
|
|
send : (Result Error a -> msg) -> Request a -> Cmd msg
|
2017-04-20 07:33:32 +00:00
|
|
|
send tagger builder =
|
2017-04-20 18:30:19 +00:00
|
|
|
builder |> HttpBuilder.send (toResponse >> tagger)
|
2017-04-20 07:33:32 +00:00
|
|
|
|
|
|
|
|
2017-04-22 08:16:14 +00:00
|
|
|
fetchAccount : Client -> AccountId -> Request Account
|
|
|
|
fetchAccount client accountId =
|
2017-04-26 15:07:43 +00:00
|
|
|
fetch client (ApiUrl.account accountId) accountDecoder
|
2017-04-22 08:16:14 +00:00
|
|
|
|
|
|
|
|
2017-04-20 20:55:08 +00:00
|
|
|
fetchUserTimeline : Client -> Request (List Status)
|
2017-04-20 07:33:32 +00:00
|
|
|
fetchUserTimeline client =
|
2017-04-26 15:07:43 +00:00
|
|
|
fetch client ApiUrl.homeTimeline <| Decode.list statusDecoder
|
2017-04-20 07:33:32 +00:00
|
|
|
|
|
|
|
|
2017-04-20 20:55:08 +00:00
|
|
|
fetchLocalTimeline : Client -> Request (List Status)
|
2017-04-20 07:33:32 +00:00
|
|
|
fetchLocalTimeline client =
|
2017-04-26 15:07:43 +00:00
|
|
|
fetch client (ApiUrl.publicTimeline (Just "public")) <| Decode.list statusDecoder
|
2017-04-20 07:33:32 +00:00
|
|
|
|
|
|
|
|
2017-04-25 21:33:37 +00:00
|
|
|
fetchGlobalTimeline : Client -> Request (List Status)
|
|
|
|
fetchGlobalTimeline client =
|
2017-04-26 15:07:43 +00:00
|
|
|
fetch client (ApiUrl.publicTimeline (Nothing)) <| Decode.list statusDecoder
|
2017-04-22 14:39:19 +00:00
|
|
|
|
|
|
|
|
|
|
|
fetchNotifications : Client -> Request (List Notification)
|
|
|
|
fetchNotifications client =
|
2017-04-26 15:07:43 +00:00
|
|
|
fetch client (ApiUrl.notifications) <| Decode.list notificationDecoder
|
2017-04-20 18:30:19 +00:00
|
|
|
|
|
|
|
|
2017-04-20 20:55:08 +00:00
|
|
|
postStatus : Client -> StatusRequestBody -> Request Status
|
2017-04-20 18:30:19 +00:00
|
|
|
postStatus client statusRequestBody =
|
2017-04-26 15:07:43 +00:00
|
|
|
HttpBuilder.post (ApiUrl.statuses client.server)
|
2017-04-20 18:30:19 +00:00
|
|
|
|> HttpBuilder.withHeader "Authorization" ("Bearer " ++ client.token)
|
|
|
|
|> HttpBuilder.withExpect (Http.expectJson statusDecoder)
|
|
|
|
|> HttpBuilder.withJsonBody (statusRequestBodyEncoder statusRequestBody)
|
2017-04-23 08:18:47 +00:00
|
|
|
|
|
|
|
|
|
|
|
reblog : Client -> Int -> Request Status
|
|
|
|
reblog client id =
|
2017-04-26 15:07:43 +00:00
|
|
|
HttpBuilder.post (ApiUrl.reblog client.server id)
|
2017-04-23 08:18:47 +00:00
|
|
|
|> HttpBuilder.withHeader "Authorization" ("Bearer " ++ client.token)
|
|
|
|
|> HttpBuilder.withExpect (Http.expectJson statusDecoder)
|
|
|
|
|
|
|
|
|
|
|
|
unreblog : Client -> Int -> Request Status
|
|
|
|
unreblog client id =
|
2017-04-26 15:07:43 +00:00
|
|
|
HttpBuilder.post (ApiUrl.unreblog client.server id)
|
2017-04-23 08:18:47 +00:00
|
|
|
|> HttpBuilder.withHeader "Authorization" ("Bearer " ++ client.token)
|
|
|
|
|> HttpBuilder.withExpect (Http.expectJson statusDecoder)
|
|
|
|
|
|
|
|
|
|
|
|
favourite : Client -> Int -> Request Status
|
|
|
|
favourite client id =
|
2017-04-26 15:07:43 +00:00
|
|
|
HttpBuilder.post (ApiUrl.favourite client.server id)
|
2017-04-23 08:18:47 +00:00
|
|
|
|> HttpBuilder.withHeader "Authorization" ("Bearer " ++ client.token)
|
|
|
|
|> HttpBuilder.withExpect (Http.expectJson statusDecoder)
|
|
|
|
|
|
|
|
|
|
|
|
unfavourite : Client -> Int -> Request Status
|
|
|
|
unfavourite client id =
|
2017-04-26 15:07:43 +00:00
|
|
|
HttpBuilder.post (ApiUrl.unfavourite client.server id)
|
2017-04-23 08:18:47 +00:00
|
|
|
|> HttpBuilder.withHeader "Authorization" ("Bearer " ++ client.token)
|
|
|
|
|> HttpBuilder.withExpect (Http.expectJson statusDecoder)
|
2017-04-25 14:27:15 +00:00
|
|
|
|
|
|
|
|
|
|
|
subscribeToWebSockets : Client -> StreamType -> (String -> a) -> Sub a
|
|
|
|
subscribeToWebSockets client streamType message =
|
|
|
|
let
|
|
|
|
type_ =
|
|
|
|
case streamType of
|
2017-04-25 20:32:27 +00:00
|
|
|
GlobalPublicStream ->
|
|
|
|
"public"
|
2017-04-25 14:27:15 +00:00
|
|
|
|
|
|
|
LocalPublicStream ->
|
|
|
|
"public:local"
|
|
|
|
|
2017-04-25 20:32:27 +00:00
|
|
|
UserStream ->
|
|
|
|
"user"
|
2017-04-25 14:27:15 +00:00
|
|
|
|
|
|
|
url =
|
2017-04-25 20:32:27 +00:00
|
|
|
encodeUrl
|
2017-04-26 15:07:43 +00:00
|
|
|
(ApiUrl.streaming (Util.replace "https:" "wss:" client.server))
|
2017-04-25 20:32:27 +00:00
|
|
|
[ ( "access_token", client.token )
|
|
|
|
, ( "stream", type_ )
|
|
|
|
]
|
2017-04-25 14:27:15 +00:00
|
|
|
in
|
|
|
|
WebSocket.listen url message
|
|
|
|
|
|
|
|
|
2017-04-27 06:11:24 +00:00
|
|
|
decodeWebSocketMessage : String -> WebSocketEvent
|
2017-04-25 14:27:15 +00:00
|
|
|
decodeWebSocketMessage message =
|
2017-04-27 06:11:24 +00:00
|
|
|
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
|