module Mastodon exposing ( AccessTokenResult , Account , AppRegistration , Attachment , Client , Error(..) , Mention , Reblog(..) , Status , StatusRequestBody , Tag , register , registrationEncoder , clientEncoder , getAuthorizationUrl , getAccessToken , fetchPublicTimeline , fetchLocalTimeline , fetchUserTimeline , postStatus , send ) import Http import HttpBuilder import Json.Decode.Pipeline as Pipe import Json.Decode as Decode import Json.Encode as Encode -- Types type alias Server = String type alias AuthCode = String type alias ClientId = String type alias ClientSecret = String type alias StatusCode = Int type alias StatusMsg = String type alias Token = String type alias Client = { server : Server , token : Token } type Error = MastodonError StatusCode StatusMsg String | ServerError StatusCode StatusMsg String | TimeoutError | NetworkError 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 : Int , 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 : Int , url : String , username : String , acct : 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 -- Msg type StatusListResult = Result Http.Error (List Status) type alias AccessTokenResult = { server : Server , accessToken : Token } -- 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 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 -- 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 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 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 (server ++ "/api/v1/apps") |> HttpBuilder.withExpect (Http.expectJson (appRegistrationDecoder server scope)) |> HttpBuilder.withJsonBody (appRegistrationEncoder client_name redirect_uri scope website) getAuthorizationUrl : AppRegistration -> String getAuthorizationUrl registration = encodeUrl (registration.server ++ "/oauth/authorize") [ ( "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 (registration.server ++ "/oauth/token") |> 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) fetchUserTimeline : Client -> Request (List Status) fetchUserTimeline client = fetch client "/api/v1/timelines/home" (Decode.list statusDecoder) fetchLocalTimeline : Client -> Request (List Status) fetchLocalTimeline client = fetch client "/api/v1/timelines/public?local=true" (Decode.list statusDecoder) fetchPublicTimeline : Client -> Request (List Status) fetchPublicTimeline client = fetch client "/api/v1/timelines/public" (Decode.list statusDecoder) postStatus : Client -> StatusRequestBody -> Request Status postStatus client statusRequestBody = HttpBuilder.post (client.server ++ "/api/v1/statuses") |> HttpBuilder.withHeader "Authorization" ("Bearer " ++ client.token) |> HttpBuilder.withExpect (Http.expectJson statusDecoder) |> HttpBuilder.withJsonBody (statusRequestBodyEncoder statusRequestBody)