2017-04-27 10:34:27 -04:00
|
|
|
module Mastodon.Http
|
|
|
|
exposing
|
2017-05-05 11:26:49 -04:00
|
|
|
( Links
|
|
|
|
, Action(..)
|
|
|
|
, Request
|
|
|
|
, Response
|
|
|
|
, extractLinks
|
2017-04-27 10:34:27 -04:00
|
|
|
, getAuthorizationUrl
|
|
|
|
, send
|
2017-05-05 11:26:49 -04:00
|
|
|
, withClient
|
|
|
|
, withBodyDecoder
|
|
|
|
, withQueryParams
|
2017-04-27 10:34:27 -04:00
|
|
|
)
|
|
|
|
|
2017-05-05 11:26:49 -04:00
|
|
|
import Dict
|
|
|
|
import Dict.Extra exposing (mapKeys)
|
2017-04-27 10:34:27 -04:00
|
|
|
import Http
|
2017-05-02 16:26:13 -04:00
|
|
|
import HttpBuilder as Build
|
2017-04-27 10:34:27 -04:00
|
|
|
import Json.Decode as Decode
|
|
|
|
import Mastodon.ApiUrl as ApiUrl
|
|
|
|
import Mastodon.Decoder exposing (..)
|
|
|
|
import Mastodon.Encoder exposing (..)
|
|
|
|
import Mastodon.Model exposing (..)
|
|
|
|
|
|
|
|
|
2017-05-05 11:26:49 -04:00
|
|
|
type Action
|
|
|
|
= GET String
|
|
|
|
| POST String
|
|
|
|
| DELETE String
|
|
|
|
|
|
|
|
|
|
|
|
type Link
|
|
|
|
= Prev
|
|
|
|
| Next
|
|
|
|
| None
|
|
|
|
|
|
|
|
|
|
|
|
type alias Links =
|
|
|
|
{ prev : Maybe String
|
|
|
|
, next : Maybe String
|
|
|
|
}
|
2017-05-03 02:52:39 -04:00
|
|
|
|
|
|
|
|
2017-04-27 10:34:27 -04:00
|
|
|
type alias Request a =
|
2017-05-05 11:26:49 -04:00
|
|
|
Build.RequestBuilder (Response a)
|
|
|
|
|
|
|
|
|
|
|
|
type alias Response a =
|
|
|
|
{ decoded : a
|
|
|
|
, links : Links
|
|
|
|
}
|
2017-04-27 10:34:27 -04:00
|
|
|
|
|
|
|
|
|
|
|
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
|
|
|
|
|
|
|
|
|
2017-05-05 11:26:49 -04:00
|
|
|
extractLinks : Dict.Dict String String -> Links
|
|
|
|
extractLinks headers =
|
|
|
|
-- The link header content is this form:
|
|
|
|
-- <https://...&max_id=123456>; rel="next", <https://...&since_id=123456>; rel="prev"
|
|
|
|
-- Note: Chrome and Firefox don't expose header names the same way. Firefox
|
|
|
|
-- will use "Link" when Chrome uses "link"; that's why we lowercase them.
|
2017-05-02 16:05:46 -04:00
|
|
|
let
|
2017-05-05 11:26:49 -04:00
|
|
|
crop =
|
|
|
|
(String.dropLeft 1) >> (String.dropRight 1)
|
|
|
|
|
|
|
|
parseDef parts =
|
|
|
|
case parts of
|
|
|
|
[ url, "rel=\"next\"" ] ->
|
|
|
|
[ ( "next", crop url ) ]
|
|
|
|
|
|
|
|
[ url, "rel=\"prev\"" ] ->
|
|
|
|
[ ( "prev", crop url ) ]
|
|
|
|
|
|
|
|
_ ->
|
|
|
|
[]
|
|
|
|
|
|
|
|
parseLink link =
|
|
|
|
link
|
|
|
|
|> String.split ";"
|
|
|
|
|> List.map String.trim
|
|
|
|
|> parseDef
|
|
|
|
|
|
|
|
parseLinks content =
|
|
|
|
content
|
|
|
|
|> String.split ","
|
|
|
|
|> List.map String.trim
|
|
|
|
|> List.map parseLink
|
|
|
|
|> List.concat
|
|
|
|
|> Dict.fromList
|
2017-05-02 16:05:46 -04:00
|
|
|
in
|
2017-05-05 11:26:49 -04:00
|
|
|
case (headers |> mapKeys String.toLower |> Dict.get "link") of
|
|
|
|
Nothing ->
|
|
|
|
{ prev = Nothing, next = Nothing }
|
|
|
|
|
|
|
|
Just content ->
|
|
|
|
let
|
|
|
|
links =
|
|
|
|
parseLinks content
|
|
|
|
in
|
|
|
|
{ prev = (Dict.get "prev" links)
|
|
|
|
, next = (Dict.get "next" links)
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
decodeResponse : Decode.Decoder a -> Http.Response String -> Result.Result String (Response a)
|
|
|
|
decodeResponse decoder response =
|
|
|
|
let
|
|
|
|
decoded =
|
|
|
|
Decode.decodeString decoder response.body
|
2017-05-02 16:26:13 -04:00
|
|
|
|
2017-05-05 11:26:49 -04:00
|
|
|
links =
|
|
|
|
extractLinks response.headers
|
|
|
|
in
|
|
|
|
case decoded of
|
|
|
|
Ok decoded ->
|
|
|
|
Ok <| Response decoded links
|
2017-05-02 16:26:13 -04:00
|
|
|
|
2017-05-05 11:26:49 -04:00
|
|
|
Err error ->
|
|
|
|
Err error
|
2017-04-27 10:34:27 -04:00
|
|
|
|
|
|
|
|
|
|
|
getAuthorizationUrl : AppRegistration -> String
|
|
|
|
getAuthorizationUrl registration =
|
2017-05-02 16:05:46 -04:00
|
|
|
encodeUrl (registration.server ++ ApiUrl.oauthAuthorize)
|
2017-04-27 10:34:27 -04:00
|
|
|
[ ( "response_type", "code" )
|
|
|
|
, ( "client_id", registration.client_id )
|
|
|
|
, ( "scope", registration.scope )
|
|
|
|
, ( "redirect_uri", registration.redirect_uri )
|
|
|
|
]
|
|
|
|
|
|
|
|
|
2017-05-05 11:26:49 -04:00
|
|
|
send : (Result Error a -> msg) -> Build.RequestBuilder a -> Cmd msg
|
|
|
|
send tagger request =
|
|
|
|
Build.send (toResponse >> tagger) request
|
2017-04-27 10:34:27 -04:00
|
|
|
|
|
|
|
|
2017-05-05 11:26:49 -04:00
|
|
|
isLinkUrl : String -> Bool
|
|
|
|
isLinkUrl url =
|
|
|
|
String.contains "max_id=" url || String.contains "since_id=" url
|
2017-04-27 16:01:51 -04:00
|
|
|
|
|
|
|
|
2017-05-05 11:26:49 -04:00
|
|
|
withClient : Client -> Build.RequestBuilder a -> Build.RequestBuilder a
|
|
|
|
withClient { server, token } builder =
|
|
|
|
let
|
|
|
|
finalUrl =
|
|
|
|
if isLinkUrl builder.url then
|
|
|
|
builder.url
|
|
|
|
else
|
|
|
|
server ++ builder.url
|
|
|
|
in
|
|
|
|
{ builder | url = finalUrl }
|
|
|
|
|> Build.withHeader "Authorization" ("Bearer " ++ token)
|
2017-04-29 16:48:55 -04:00
|
|
|
|
|
|
|
|
2017-05-05 11:26:49 -04:00
|
|
|
withBodyDecoder : Decode.Decoder b -> Build.RequestBuilder a -> Request b
|
|
|
|
withBodyDecoder decoder builder =
|
|
|
|
Build.withExpect (Http.expectStringResponse (decodeResponse decoder)) builder
|
2017-04-29 16:48:55 -04:00
|
|
|
|
|
|
|
|
2017-05-05 11:26:49 -04:00
|
|
|
withQueryParams : List ( String, String ) -> Build.RequestBuilder a -> Build.RequestBuilder a
|
|
|
|
withQueryParams params builder =
|
|
|
|
if isLinkUrl builder.url then
|
|
|
|
-- that's a link url, don't append any query string
|
|
|
|
builder
|
|
|
|
else
|
|
|
|
Build.withQueryParams params builder
|