flewkey/tooty
1
0
Fork 0
Code Releases Activity

Fix #64: Handle paginations. (#131)

Browse Source 
* Extract link header values.
* Expose response link header to a new type.
* Add tests for Mastodon.http.extractLinks.
* WiP
* Wrap decoded content and links into a new Response type.
* Update MastodonMsg handlers so they handle responses.
* Remove debug statements.
* Add edge case to tests.
* Add missing TODO comment.
* Simplifies Mastodon.Http signatures
* Paginate the user timeline.
* I lost my mind. May revert.
* Updated Http API to be more explicit.
* Fuck namespaces.
* Cosmetics.
* I'm burnt out, lost 10 pounds, but it works.
* Fix qs param for local tl was appended to link url.
* Fix my own mediocrity.
* Fix oauth endpoints.
* Fix Link header case handling with Firefox.
* Add test case for link header name case handling.
This commit is contained in:
Nicolas Perriault 2017-05-05 17:26:49 +02:00 committed by GitHub
parent f542bcfc3b
commit 2b74533960
11 changed files with 613 additions and 383 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
elm-package.json
View File

@ -9,6 +9,7 @@
"exposed-modules": [],
"dependencies": {
"NoRedInk/elm-decode-pipeline": "3.0.0 <= v < 4.0.0",
"elm-community/dict-extra": "1.5.0 <= v < 2.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",

279
src/Command.elm
View File

@ -8,9 +8,13 @@ module Command
, loadNotifications
, loadUserAccount
, loadAccount
, loadAccountTimeline
, loadAccountFollowers
, loadAccountFollowing
, loadUserTimeline
, loadLocalTimeline
, loadGlobalTimeline
, loadAccountTimeline
, loadNextTimeline
, loadRelationships
, loadThread
, loadTimelines
@ -33,9 +37,13 @@ module Command
import Dom
import Dom.Scroll
import Json.Encode as Encode
import Json.Decode as Decode
import HttpBuilder
import Mastodon.ApiUrl as ApiUrl
import Mastodon.Decoder exposing (..)
import Mastodon.Encoder exposing (..)
import Mastodon.Http exposing (..)
import Mastodon.Model exposing (..)
import Mastodon.Encoder
import Mastodon.Http
import Navigation
import Ports
import Task
@ -49,9 +57,7 @@ initCommands registration client authCode =
Just authCode ->
case registration of
Just registration ->
[ Mastodon.Http.getAccessToken registration authCode
|> Mastodon.Http.send (MastodonEvent << AccessToken)
]
[ getAccessToken registration authCode ]
Nothing ->
[]
@ -60,15 +66,23 @@ initCommands registration client authCode =
[ loadUserAccount client, loadTimelines client ]
getAccessToken : AppRegistration -> String -> Cmd Msg
getAccessToken registration authCode =
HttpBuilder.post (registration.server ++ ApiUrl.oauthToken)
|> HttpBuilder.withJsonBody (authorizationCodeEncoder registration authCode)
|> withBodyDecoder (accessTokenDecoder registration)
|> send (MastodonEvent << AccessToken)
navigateToAuthUrl : AppRegistration -> Cmd Msg
navigateToAuthUrl registration =
Navigation.load <| Mastodon.Http.getAuthorizationUrl registration
Navigation.load <| getAuthorizationUrl registration
registerApp : Model -> Cmd Msg
registerApp { server, location } =
let
appUrl =
redirectUri =
location.origin ++ location.pathname
cleanServer =
@ -76,36 +90,46 @@ registerApp { server, location } =
String.dropRight 1 server
else
server
in
Mastodon.Http.register
cleanServer
clientName =
"tooty"
appUrl
scope =
"read write follow"
website =
"https://github.com/n1k0/tooty"
|> Mastodon.Http.send (MastodonEvent << AppRegistered)
in
HttpBuilder.post (cleanServer ++ ApiUrl.apps)
|> withBodyDecoder (appRegistrationDecoder cleanServer scope)
|> HttpBuilder.withJsonBody
(appRegistrationEncoder clientName redirectUri scope website)
|> send (MastodonEvent << AppRegistered)
saveClient : Client -> Cmd Msg
saveClient client =
Mastodon.Encoder.clientEncoder client
clientEncoder client
|> Encode.encode 0
|> Ports.saveClient
saveRegistration : AppRegistration -> Cmd Msg
saveRegistration registration =
Mastodon.Encoder.registrationEncoder registration
registrationEncoder registration
|> Encode.encode 0
|> Ports.saveRegistration
loadNotifications : Maybe Client -> Cmd Msg
loadNotifications client =
-- TODO: handle link (see loadUserTimeline)
case client of
Just client ->
Mastodon.Http.fetchNotifications client
|> Mastodon.Http.send (MastodonEvent << Notifications)
HttpBuilder.get ApiUrl.notifications
|> withClient client
|> withBodyDecoder (Decode.list notificationDecoder)
|> send (MastodonEvent << Notifications)
Nothing ->
Cmd.none
@ -115,8 +139,10 @@ loadUserAccount : Maybe Client -> Cmd Msg
loadUserAccount client =
case client of
Just client ->
Mastodon.Http.userAccount client
|> Mastodon.Http.send (MastodonEvent << CurrentUser)
HttpBuilder.get ApiUrl.userAccount
|> withClient client
|> withBodyDecoder accountDecoder
|> send (MastodonEvent << CurrentUser)
Nothing ->
Cmd.none
@ -127,33 +153,26 @@ loadAccount client accountId =
case client of
Just client ->
Cmd.batch
[ Mastodon.Http.fetchAccount client accountId
|> Mastodon.Http.send (MastodonEvent << AccountReceived)
, Mastodon.Http.fetchRelationships client [ accountId ]
|> Mastodon.Http.send (MastodonEvent << AccountRelationship)
[ HttpBuilder.get (ApiUrl.account accountId)
|> withClient client
|> withBodyDecoder accountDecoder
|> send (MastodonEvent << AccountReceived)
, requestRelationships client [ accountId ]
|> send (MastodonEvent << AccountRelationship)
]
Nothing ->
Cmd.none
loadAccountTimeline : Maybe Client -> Int -> Cmd Msg
loadAccountTimeline client accountId =
case client of
Just client ->
Mastodon.Http.fetchAccountTimeline client accountId
|> Mastodon.Http.send (MastodonEvent << AccountTimeline)
Nothing ->
Cmd.none
loadAccountFollowers : Maybe Client -> Int -> Cmd Msg
loadAccountFollowers client accountId =
case client of
Just client ->
Mastodon.Http.fetchAccountFollowers client accountId
|> Mastodon.Http.send (MastodonEvent << AccountFollowers)
HttpBuilder.get (ApiUrl.followers accountId)
|> withClient client
|> withBodyDecoder (Decode.list accountDecoder)
|> send (MastodonEvent << AccountFollowers)
Nothing ->
Cmd.none
@ -163,8 +182,10 @@ loadAccountFollowing : Maybe Client -> Int -> Cmd Msg
loadAccountFollowing client accountId =
case client of
Just client ->
Mastodon.Http.fetchAccountFollowing client accountId
|> Mastodon.Http.send (MastodonEvent << AccountFollowing)
HttpBuilder.get (ApiUrl.following accountId)
|> withClient client
|> withBodyDecoder (Decode.list accountDecoder)
|> send (MastodonEvent << AccountFollowing)
Nothing ->
Cmd.none
@ -177,19 +198,43 @@ searchAccounts client query limit resolve =
else
case client of
Just client ->
Mastodon.Http.searchAccounts client query limit resolve
|> Mastodon.Http.send (MastodonEvent << AutoSearch)
let
qs =
[ ( "q", query )
, ( "limit", toString limit )
, ( "resolve"
, if resolve then
"true"
else
"false"
)
]
in
HttpBuilder.get ApiUrl.searchAccount
|> withClient client
|> withBodyDecoder (Decode.list accountDecoder)
|> withQueryParams qs
|> send (MastodonEvent << AutoSearch)
Nothing ->
Cmd.none
requestRelationships : Client -> List Int -> Request (List Relationship)
requestRelationships client ids =
HttpBuilder.get ApiUrl.relationships
|> withClient client
|> withBodyDecoder (Decode.list relationshipDecoder)
|> withQueryParams
(List.map (\id -> ( "id[]", toString id )) ids)
loadRelationships : Maybe Client -> List Int -> Cmd Msg
loadRelationships client accountIds =
loadRelationships client ids =
case client of
Just client ->
Mastodon.Http.fetchRelationships client accountIds
|> Mastodon.Http.send (MastodonEvent << AccountRelationships)
requestRelationships client ids
|> send (MastodonEvent << AccountRelationships)
Nothing ->
Cmd.none
@ -199,8 +244,63 @@ loadThread : Maybe Client -> Status -> Cmd Msg
loadThread client status =
case client of
Just client ->
Mastodon.Http.context client status.id
|> Mastodon.Http.send (MastodonEvent << (ContextLoaded status))
HttpBuilder.get (ApiUrl.context status.id)
|> withClient client
|> withBodyDecoder contextDecoder
|> send (MastodonEvent << (ContextLoaded status))
Nothing ->
Cmd.none
loadUserTimeline : Maybe Client -> Maybe String -> Cmd Msg
loadUserTimeline client url =
case client of
Just client ->
HttpBuilder.get (Maybe.withDefault ApiUrl.homeTimeline url)
|> withClient client
|> withBodyDecoder (Decode.list statusDecoder)
|> send (MastodonEvent << UserTimeline (url /= Nothing))
Nothing ->
Cmd.none
loadLocalTimeline : Maybe Client -> Maybe String -> Cmd Msg
loadLocalTimeline client url =
case client of
Just client ->
HttpBuilder.get (Maybe.withDefault ApiUrl.publicTimeline url)
|> withClient client
|> withBodyDecoder (Decode.list statusDecoder)
|> withQueryParams [ ( "local", "true" ) ]
|> send (MastodonEvent << LocalTimeline (url /= Nothing))
Nothing ->
Cmd.none
loadGlobalTimeline : Maybe Client -> Maybe String -> Cmd Msg
loadGlobalTimeline client url =
case client of
Just client ->
HttpBuilder.get (Maybe.withDefault ApiUrl.publicTimeline url)
|> withClient client
|> withBodyDecoder (Decode.list statusDecoder)
|> send (MastodonEvent << GlobalTimeline (url /= Nothing))
Nothing ->
Cmd.none
loadAccountTimeline : Maybe Client -> Int -> Maybe String -> Cmd Msg
loadAccountTimeline client accountId url =
case client of
Just client ->
HttpBuilder.get (Maybe.withDefault (ApiUrl.accountTimeline accountId) url)
|> withClient client
|> withBodyDecoder (Decode.list statusDecoder)
|> send (MastodonEvent << AccountTimeline (url /= Nothing))
Nothing ->
Cmd.none
@ -208,19 +308,35 @@ loadThread client status =
loadTimelines : Maybe Client -> Cmd Msg
loadTimelines client =
case client of
Just client ->
Cmd.batch
[ 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
]
Cmd.batch
[ loadUserTimeline client Nothing
, loadLocalTimeline client Nothing
, loadGlobalTimeline client Nothing
, loadNotifications client
]
Nothing ->
loadNextTimeline : Maybe Client -> CurrentView -> Timeline -> Cmd Msg
loadNextTimeline client currentView { id, links } =
case id of
"home-timeline" ->
loadUserTimeline client links.next
"local-timeline" ->
loadLocalTimeline client links.next
"global-timeline" ->
loadGlobalTimeline client links.next
"account-timeline" ->
case currentView of
AccountView account ->
loadAccountTimeline client account.id links.next
_ ->
Cmd.none
_ ->
Cmd.none
@ -228,8 +344,11 @@ postStatus : Maybe Client -> StatusRequestBody -> Cmd Msg
postStatus client draft =
case client of
Just client ->
Mastodon.Http.postStatus client draft
|> Mastodon.Http.send (MastodonEvent << StatusPosted)
HttpBuilder.post ApiUrl.statuses
|> withClient client
|> HttpBuilder.withJsonBody (statusRequestBodyEncoder draft)
|> withBodyDecoder statusDecoder
|> send (MastodonEvent << StatusPosted)
Nothing ->
Cmd.none
@ -244,8 +363,10 @@ deleteStatus : Maybe Client -> Int -> Cmd Msg
deleteStatus client id =
case client of
Just client ->
Mastodon.Http.deleteStatus client id
|> Mastodon.Http.send (MastodonEvent << StatusDeleted)
HttpBuilder.delete (ApiUrl.status id)
|> withClient client
|> withBodyDecoder (Decode.succeed id)
|> send (MastodonEvent << StatusDeleted)
Nothing ->
Cmd.none
@ -255,8 +376,10 @@ reblogStatus : Maybe Client -> Int -> Cmd Msg
reblogStatus client statusId =
case client of
Just client ->
Mastodon.Http.reblog client statusId
|> Mastodon.Http.send (MastodonEvent << Reblogged)
HttpBuilder.post (ApiUrl.reblog statusId)
|> withClient client
|> withBodyDecoder statusDecoder
|> send (MastodonEvent << Reblogged)
Nothing ->
Cmd.none
@ -266,8 +389,10 @@ unreblogStatus : Maybe Client -> Int -> Cmd Msg
unreblogStatus client statusId =
case client of
Just client ->
Mastodon.Http.unreblog client statusId
|> Mastodon.Http.send (MastodonEvent << Unreblogged)
HttpBuilder.post (ApiUrl.unreblog statusId)
|> withClient client
|> withBodyDecoder statusDecoder
|> send (MastodonEvent << Unreblogged)
Nothing ->
Cmd.none
@ -277,8 +402,10 @@ favouriteStatus : Maybe Client -> Int -> Cmd Msg
favouriteStatus client statusId =
case client of
Just client ->
Mastodon.Http.favourite client statusId
|> Mastodon.Http.send (MastodonEvent << FavoriteAdded)
HttpBuilder.post (ApiUrl.favourite statusId)
|> withClient client
|> withBodyDecoder statusDecoder
|> send (MastodonEvent << FavoriteAdded)
Nothing ->
Cmd.none
@ -288,8 +415,10 @@ unfavouriteStatus : Maybe Client -> Int -> Cmd Msg
unfavouriteStatus client statusId =
case client of
Just client ->
Mastodon.Http.unfavourite client statusId
|> Mastodon.Http.send (MastodonEvent << FavoriteRemoved)
HttpBuilder.post (ApiUrl.unfavourite statusId)
|> withClient client
|> withBodyDecoder statusDecoder
|> send (MastodonEvent << FavoriteRemoved)
Nothing ->
Cmd.none
@ -299,8 +428,10 @@ follow : Maybe Client -> Int -> Cmd Msg
follow client id =
case client of
Just client ->
Mastodon.Http.follow client id
|> Mastodon.Http.send (MastodonEvent << AccountFollowed)
HttpBuilder.post (ApiUrl.follow id)
|> withClient client
|> withBodyDecoder relationshipDecoder
|> send (MastodonEvent << AccountFollowed)
Nothing ->
Cmd.none
@ -310,8 +441,10 @@ unfollow : Maybe Client -> Int -> Cmd Msg
unfollow client id =
case client of
Just client ->
Mastodon.Http.unfollow client id
|> Mastodon.Http.send (MastodonEvent << AccountUnfollowed)
HttpBuilder.post (ApiUrl.unfollow id)
|> withClient client
|> withBodyDecoder relationshipDecoder
|> send (MastodonEvent << AccountUnfollowed)
Nothing ->
Cmd.none

278
src/Mastodon/Http.elm
View File

@ -1,32 +1,19 @@
module Mastodon.Http
exposing
( Request
, context
, reblog
, unreblog
, favourite
, unfavourite
, follow
, unfollow
, register
( Links
, Action(..)
, Request
, Response
, extractLinks
, getAuthorizationUrl
, getAccessToken
, fetchAccount
, fetchAccountTimeline
, fetchAccountFollowers
, fetchAccountFollowing
, fetchLocalTimeline
, fetchNotifications
, fetchGlobalTimeline
, fetchUserTimeline
, fetchRelationships
, postStatus
, deleteStatus
, userAccount
, send
, searchAccounts
, withClient
, withBodyDecoder
, withQueryParams
)
import Dict
import Dict.Extra exposing (mapKeys)
import Http
import HttpBuilder as Build
import Json.Decode as Decode
@ -36,14 +23,32 @@ import Mastodon.Encoder exposing (..)
import Mastodon.Model exposing (..)
type Method
= GET
| POST
| DELETE
type Action
= GET String
| POST String
| DELETE String
type Link
= Prev
| Next
| None
type alias Links =
{ prev : Maybe String
, next : Maybe String
}
type alias Request a =
Build.RequestBuilder a
Build.RequestBuilder (Response a)
type alias Response a =
{ decoded : a
, links : Links
}
extractMastodonError : Int -> String -> String -> Error
@ -80,40 +85,70 @@ toResponse result =
Result.mapError extractError result
request : String -> Method -> String -> Decode.Decoder a -> Request a
request server method endpoint decoder =
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.
let
httpMethod =
case method of
GET ->
Build.get
crop =
(String.dropLeft 1) >> (String.dropRight 1)
POST ->
Build.post
parseDef parts =
case parts of
[ url, "rel=\"next\"" ] ->
[ ( "next", crop url ) ]
DELETE ->
Build.delete
[ 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
in
httpMethod (server ++ endpoint)
|> Build.withExpect (Http.expectJson decoder)
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)
}
authRequest : Client -> Method -> String -> Decode.Decoder a -> Request a
authRequest client method endpoint decoder =
request client.server method endpoint decoder
|> Build.withHeader "Authorization" ("Bearer " ++ client.token)
decodeResponse : Decode.Decoder a -> Http.Response String -> Result.Result String (Response a)
decodeResponse decoder response =
let
decoded =
Decode.decodeString decoder response.body
links =
extractLinks response.headers
in
case decoded of
Ok decoded ->
Ok <| Response decoded links
register : String -> String -> String -> String -> String -> Request AppRegistration
register server clientName redirectUri scope website =
request server POST ApiUrl.apps (appRegistrationDecoder server scope)
|> Build.withJsonBody (appRegistrationEncoder clientName redirectUri scope website)
getAccessToken : AppRegistration -> String -> Request AccessTokenResult
getAccessToken registration authCode =
request registration.server POST ApiUrl.oauthToken (accessTokenDecoder registration)
|> Build.withJsonBody (authorizationCodeEncoder registration authCode)
Err error ->
Err error
getAuthorizationUrl : AppRegistration -> String
@ -126,119 +161,38 @@ getAuthorizationUrl registration =
]
send : (Result Error a -> msg) -> Request a -> Cmd msg
send tagger builder =
Build.send (toResponse >> tagger) builder
send : (Result Error a -> msg) -> Build.RequestBuilder a -> Cmd msg
send tagger request =
Build.send (toResponse >> tagger) request
fetchAccount : Client -> Int -> Request Account
fetchAccount client accountId =
authRequest client GET (ApiUrl.account accountId) accountDecoder
isLinkUrl : String -> Bool
isLinkUrl url =
String.contains "max_id=" url || String.contains "since_id=" url
fetchUserTimeline : Client -> Request (List Status)
fetchUserTimeline client =
authRequest client GET ApiUrl.homeTimeline <| Decode.list statusDecoder
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)
fetchRelationships : Client -> List Int -> Request (List Relationship)
fetchRelationships client ids =
authRequest client GET ApiUrl.relationships (Decode.list relationshipDecoder)
|> Build.withQueryParams (List.map (\id -> ( "id[]", toString id )) ids)
withBodyDecoder : Decode.Decoder b -> Build.RequestBuilder a -> Request b
withBodyDecoder decoder builder =
Build.withExpect (Http.expectStringResponse (decodeResponse decoder)) builder
fetchLocalTimeline : Client -> Request (List Status)
fetchLocalTimeline client =
authRequest client GET ApiUrl.publicTimeline (Decode.list statusDecoder)
|> Build.withQueryParams [ ( "local", "true" ) ]
fetchGlobalTimeline : Client -> Request (List Status)
fetchGlobalTimeline client =
authRequest client GET ApiUrl.publicTimeline <| Decode.list statusDecoder
fetchAccountTimeline : Client -> Int -> Request (List Status)
fetchAccountTimeline client id =
authRequest client GET (ApiUrl.accountTimeline id) <| Decode.list statusDecoder
fetchNotifications : Client -> Request (List Notification)
fetchNotifications client =
authRequest client GET (ApiUrl.notifications) <| Decode.list notificationDecoder
fetchAccountFollowers : Client -> Int -> Request (List Account)
fetchAccountFollowers client accountId =
authRequest client GET (ApiUrl.followers accountId) <| Decode.list accountDecoder
fetchAccountFollowing : Client -> Int -> Request (List Account)
fetchAccountFollowing client accountId =
authRequest client GET (ApiUrl.following accountId) <| Decode.list accountDecoder
searchAccounts : Client -> String -> Int -> Bool -> Request (List Account)
searchAccounts client query limit resolve =
authRequest client GET ApiUrl.searchAccount (Decode.list accountDecoder)
|> Build.withQueryParams
[ ( "q", query )
, ( "limit", toString limit )
, ( "resolve"
, if resolve then
"true"
else
"false"
)
]
userAccount : Client -> Request Account
userAccount client =
authRequest client GET ApiUrl.userAccount accountDecoder
postStatus : Client -> StatusRequestBody -> Request Status
postStatus client statusRequestBody =
authRequest client POST ApiUrl.statuses statusDecoder
|> Build.withJsonBody (statusRequestBodyEncoder statusRequestBody)
deleteStatus : Client -> Int -> Request Int
deleteStatus client id =
authRequest client DELETE (ApiUrl.status id) <| Decode.succeed id
context : Client -> Int -> Request Context
context client id =
authRequest client GET (ApiUrl.context id) contextDecoder
reblog : Client -> Int -> Request Status
reblog client id =
authRequest client POST (ApiUrl.reblog id) statusDecoder
unreblog : Client -> Int -> Request Status
unreblog client id =
authRequest client POST (ApiUrl.unreblog id) statusDecoder
favourite : Client -> Int -> Request Status
favourite client id =
authRequest client POST (ApiUrl.favourite id) statusDecoder
unfavourite : Client -> Int -> Request Status
unfavourite client id =
authRequest client POST (ApiUrl.unfavourite id) statusDecoder
follow : Client -> Int -> Request Relationship
follow client id =
authRequest client POST (ApiUrl.follow id) relationshipDecoder
unfollow : Client -> Int -> Request Relationship
unfollow client id =
authRequest client POST (ApiUrl.unfollow id) relationshipDecoder
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

195
src/Model.elm
View File

@ -5,6 +5,7 @@ import Command
import Navigation
import Mastodon.Decoder
import Mastodon.Helper
import Mastodon.Http exposing (Links)
import Mastodon.Model exposing (..)
import Mastodon.WebSocket
import String.Extra
@ -55,10 +56,10 @@ init flags location =
{ server = ""
, registration = flags.registration
, client = flags.client
, userTimeline = []
, localTimeline = []
, globalTimeline = []
, accountTimeline = []
, userTimeline = emptyTimeline "home-timeline"
, localTimeline = emptyTimeline "local-timeline"
, globalTimeline = emptyTimeline "global-timeline"
, accountTimeline = emptyTimeline "account-timeline"
, accountFollowers = []
, accountFollowing = []
, accountRelationships = []
@ -76,6 +77,14 @@ init flags location =
! [ Command.initCommands flags.registration flags.client authCode ]
emptyTimeline : String -> Timeline
emptyTimeline id =
{ id = id
, statuses = []
, links = Links Nothing Nothing
}
preferredTimeline : Model -> CurrentView
preferredTimeline model =
if model.useGlobalTimeline then
@ -84,11 +93,6 @@ preferredTimeline model =
LocalTimelineView
truncate : List a -> List a
truncate entries =
List.take maxBuffer entries
errorText : Error -> String
errorText error =
case error of
@ -129,12 +133,15 @@ updateTimelinesWithBoolFlag statusId flag statusUpdater model =
statusUpdater status
else
status
updateTimeline timeline =
{ timeline | statuses = List.map update timeline.statuses }
in
{ model
| userTimeline = List.map update model.userTimeline
, accountTimeline = List.map update model.accountTimeline
, localTimeline = List.map update model.localTimeline
, globalTimeline = List.map update model.globalTimeline
| userTimeline = updateTimeline model.userTimeline
, accountTimeline = updateTimeline model.accountTimeline
, localTimeline = updateTimeline model.localTimeline
, globalTimeline = updateTimeline model.globalTimeline
, currentView =
case model.currentView of
ThreadView thread ->
@ -191,16 +198,16 @@ processReblog statusId flag model =
model
deleteStatusFromTimeline : Int -> List Status -> List Status
deleteStatusFromTimeline : Int -> Timeline -> Timeline
deleteStatusFromTimeline statusId timeline =
timeline
|> List.filter
(\s ->
s.id
/= statusId
&& (Mastodon.Helper.extractReblog s).id
/= statusId
)
let
update status =
status.id
/= statusId
&& (Mastodon.Helper.extractReblog status).id
/= statusId
in
{ timeline | statuses = List.filter update timeline.statuses }
deleteStatusFromAllTimelines : Int -> Model -> Model
@ -473,15 +480,32 @@ updateViewer viewerMsg viewer =
(Just <| Viewer attachments attachment) ! []
updateTimeline : Bool -> List Status -> Links -> Timeline -> Timeline
updateTimeline append statuses links timeline =
let
newStatuses =
if append then
List.concat [ timeline.statuses, statuses ]
else
statuses
in
{ timeline | statuses = newStatuses, links = links }
prependStatusToTimeline : Status -> Timeline -> Timeline
prependStatusToTimeline status timeline =
{ timeline | statuses = status :: timeline.statuses }
processMastodonEvent : MastodonMsg -> Model -> ( Model, Cmd Msg )
processMastodonEvent msg model =
case msg of
AccessToken result ->
case result of
Ok { server, accessToken } ->
Ok { decoded } ->
let
client =
Client server accessToken
Client decoded.server decoded.accessToken
in
{ model | client = Just client }
! [ Command.loadTimelines <| Just client
@ -495,26 +519,26 @@ processMastodonEvent msg model =
AccountFollowed result ->
case result of
Ok relationship ->
processFollowEvent relationship True model ! []
Ok { decoded } ->
processFollowEvent decoded True model ! []
Err error ->
{ model | errors = (errorText error) :: model.errors } ! []
AccountUnfollowed result ->
case result of
Ok relationship ->
processFollowEvent relationship False model ! []
Ok { decoded } ->
processFollowEvent decoded False model ! []
Err error ->
{ model | errors = (errorText error) :: model.errors } ! []
AppRegistered result ->
case result of
Ok registration ->
{ model | registration = Just registration }
! [ Command.saveRegistration registration
, Command.navigateToAuthUrl registration
Ok { decoded } ->
{ model | registration = Just decoded }
! [ Command.saveRegistration decoded
, Command.navigateToAuthUrl decoded
]
Err error ->
@ -522,8 +546,8 @@ processMastodonEvent msg model =
ContextLoaded status result ->
case result of
Ok context ->
{ model | currentView = ThreadView (Thread status context) }
Ok { decoded } ->
{ model | currentView = ThreadView (Thread status decoded) }
! [ Command.scrollToThreadStatus <| toString status.id ]
Err error ->
@ -535,15 +559,15 @@ processMastodonEvent msg model =
CurrentUser result ->
case result of
Ok currentUser ->
{ model | currentUser = Just currentUser } ! []
Ok { decoded } ->
{ model | currentUser = Just decoded } ! []
Err error ->
{ model | errors = (errorText error) :: model.errors } ! []
FavoriteAdded result ->
case result of
Ok status ->
Ok _ ->
model ! [ Command.loadNotifications model.client ]
Err error ->
@ -551,39 +575,40 @@ processMastodonEvent msg model =
FavoriteRemoved result ->
case result of
Ok status ->
Ok _ ->
model ! [ Command.loadNotifications model.client ]
Err error ->
{ model | errors = (errorText error) :: model.errors } ! []
LocalTimeline result ->
LocalTimeline append result ->
case result of
Ok localTimeline ->
{ model | localTimeline = localTimeline } ! []
Ok { decoded, links } ->
{ model | localTimeline = updateTimeline append decoded links model.localTimeline } ! []
Err error ->
{ model | errors = (errorText error) :: model.errors } ! []
Notifications result ->
case result of
Ok notifications ->
{ model | notifications = Mastodon.Helper.aggregateNotifications notifications } ! []
Ok { decoded } ->
-- TODO: store next link
{ model | notifications = Mastodon.Helper.aggregateNotifications decoded } ! []
Err error ->
{ model | errors = (errorText error) :: model.errors } ! []
GlobalTimeline result ->
GlobalTimeline append result ->
case result of
Ok globalTimeline ->
{ model | globalTimeline = globalTimeline } ! []
Ok { decoded, links } ->
{ model | globalTimeline = updateTimeline append decoded links model.globalTimeline } ! []
Err error ->
{ model | errors = (errorText error) :: model.errors } ! []
Reblogged result ->
case result of
Ok status ->
Ok _ ->
model ! [ Command.loadNotifications model.client ]
Err error ->
@ -591,21 +616,21 @@ processMastodonEvent msg model =
StatusPosted _ ->
{ model | draft = defaultDraft }
! [ Command.scrollColumnToTop "home"
! [ Command.scrollColumnToTop "home-timeline"
, Command.updateDomStatus defaultDraft.status
]
StatusDeleted result ->
case result of
Ok id ->
deleteStatusFromAllTimelines id model ! []
Ok { decoded } ->
deleteStatusFromAllTimelines decoded model ! []
Err error ->
{ model | errors = (errorText error) :: model.errors } ! []
Unreblogged result ->
case result of
Ok status ->
Ok _ ->
model ! [ Command.loadNotifications model.client ]
Err error ->
@ -613,9 +638,9 @@ processMastodonEvent msg model =
AccountReceived result ->
case result of
Ok account ->
{ model | currentView = AccountView account }
! [ Command.loadAccountTimeline model.client account.id ]
Ok { decoded } ->
{ model | currentView = AccountView decoded }
! [ Command.loadAccountTimeline model.client decoded.id model.userTimeline.links.next ]
Err error ->
{ model
@ -624,55 +649,60 @@ processMastodonEvent msg model =
}
! []
AccountTimeline result ->
AccountTimeline append result ->
case result of
Ok statuses ->
{ model | accountTimeline = statuses } ! []
Ok { decoded, links } ->
{ model | accountTimeline = updateTimeline append decoded links model.accountTimeline } ! []
Err error ->
{ model | errors = (errorText error) :: model.errors } ! []
AccountFollowers result ->
case result of
Ok followers ->
{ model | accountFollowers = followers }
! [ Command.loadRelationships model.client <| List.map .id followers ]
Ok { decoded } ->
-- TODO: store next link
{ model | accountFollowers = decoded }
! [ Command.loadRelationships model.client <| List.map .id decoded ]
Err error ->
{ model | errors = (errorText error) :: model.errors } ! []
AccountFollowing result ->
case result of
Ok following ->
{ model | accountFollowing = following }
! [ Command.loadRelationships model.client <| List.map .id following ]
Ok { decoded } ->
-- TODO: store next link
{ model | accountFollowing = decoded }
! [ Command.loadRelationships model.client <| List.map .id decoded ]
Err error ->
{ model | errors = (errorText error) :: model.errors } ! []
AccountRelationship result ->
case result of
Ok [ relationship ] ->
{ model | accountRelationship = Just relationship } ! []
Ok { decoded } ->
case decoded of
[ relationship ] ->
{ model | accountRelationship = Just relationship } ! []
Ok _ ->
model ! []
_ ->
model ! []
Err error ->
{ model | errors = (errorText error) :: model.errors } ! []
AccountRelationships result ->
case result of
Ok relationships ->
{ model | accountRelationships = relationships } ! []
Ok { decoded } ->
-- TODO: store next link
{ model | accountRelationships = decoded } ! []
Err error ->
{ model | errors = (errorText error) :: model.errors } ! []
UserTimeline result ->
UserTimeline append result ->
case result of
Ok userTimeline ->
{ model | userTimeline = userTimeline } ! []
Ok { decoded, links } ->
{ model | userTimeline = updateTimeline append decoded links model.userTimeline } ! []
Err error ->
{ model | errors = (errorText error) :: model.errors } ! []
@ -683,16 +713,16 @@ processMastodonEvent msg model =
model.draft
in
case result of
Ok accounts ->
Ok { decoded } ->
{ model
| draft =
{ draft
| showAutoMenu =
showAutoMenu
accounts
decoded
draft.autoAtPosition
draft.autoQuery
, autoAccounts = accounts
, autoAccounts = decoded
}
}
-- Force selection of the first item after each
@ -734,7 +764,7 @@ processWebSocketMsg msg model =
Mastodon.WebSocket.StatusUpdateEvent result ->
case result of
Ok status ->
{ model | userTimeline = truncate (status :: model.userTimeline) } ! []
{ model | userTimeline = prependStatusToTimeline status model.userTimeline } ! []
Err error ->
{ model | errors = error :: model.errors } ! []
@ -756,7 +786,7 @@ processWebSocketMsg msg model =
notification
model.notifications
in
{ model | notifications = truncate notifications } ! []
{ model | notifications = notifications } ! []
Err error ->
{ model | errors = error :: model.errors } ! []
@ -769,7 +799,7 @@ processWebSocketMsg msg model =
Mastodon.WebSocket.StatusUpdateEvent result ->
case result of
Ok status ->
{ model | localTimeline = truncate (status :: model.localTimeline) } ! []
{ model | localTimeline = prependStatusToTimeline status model.localTimeline } ! []
Err error ->
{ model | errors = error :: model.errors } ! []
@ -793,7 +823,7 @@ processWebSocketMsg msg model =
Mastodon.WebSocket.StatusUpdateEvent result ->
case result of
Ok status ->
{ model | globalTimeline = truncate (status :: model.globalTimeline) } ! []
{ model | globalTimeline = prependStatusToTimeline status model.globalTimeline } ! []
Err error ->
{ model | errors = error :: model.errors } ! []
@ -886,7 +916,7 @@ update msg model =
LoadAccount accountId ->
{ model
| accountTimeline = []
| accountTimeline = emptyTimeline "account-timeline"
, accountFollowers = []
, accountFollowing = []
, accountRelationships = []
@ -894,6 +924,9 @@ update msg model =
}
! [ Command.loadAccount model.client accountId ]
LoadNext timeline ->
model ! [ Command.loadNextTimeline model.client model.currentView timeline ]
ViewAccountFollowers account ->
{ model | currentView = AccountFollowersView account model.accountFollowers }
! [ Command.loadAccountFollowers model.client account.id ]
@ -915,7 +948,7 @@ update msg model =
CloseAccount ->
{ model
| currentView = preferredTimeline model
, accountTimeline = []
, accountTimeline = emptyTimeline "account-timeline"
, accountFollowing = []
, accountFollowers = []
}

75
src/Types.elm
View File

@ -1,6 +1,7 @@
module Types exposing (..)
import Autocomplete
import Mastodon.Http exposing (Response, Links)
import Mastodon.Model exposing (..)
import Navigation
@ -29,30 +30,34 @@ type ViewerMsg
| OpenViewer (List Attachment) Attachment
type alias MastodonResult a =
Result Error (Response a)
type MastodonMsg
= AccessToken (Result Error AccessTokenResult)
| AccountFollowed (Result Error Relationship)
| AccountFollowers (Result Error (List Account))
| AccountFollowing (Result Error (List Account))
| AccountReceived (Result Error Account)
| AccountRelationship (Result Error (List Relationship))
| AccountRelationships (Result Error (List Relationship))
| AccountTimeline (Result Error (List Status))
| AccountUnfollowed (Result Error Relationship)
| AppRegistered (Result Error AppRegistration)
| ContextLoaded Status (Result Error Context)
| CurrentUser (Result Error Account)
| FavoriteAdded (Result Error Status)
| FavoriteRemoved (Result Error Status)
| GlobalTimeline (Result Error (List Status))
| LocalTimeline (Result Error (List Status))
| Notifications (Result Error (List Notification))
| Reblogged (Result Error Status)
| StatusDeleted (Result Error Int)
| StatusPosted (Result Error Status)
| Unreblogged (Result Error Status)
| UserTimeline (Result Error (List Status))
| AutoSearch (Result Error (List Account))
= AccessToken (MastodonResult AccessTokenResult)
| AccountFollowed (MastodonResult Relationship)
| AccountFollowers (MastodonResult (List Account))
| AccountFollowing (MastodonResult (List Account))
| AccountReceived (MastodonResult Account)
| AccountRelationship (MastodonResult (List Relationship))
| AccountRelationships (MastodonResult (List Relationship))
| AccountTimeline Bool (MastodonResult (List Status))
| AccountUnfollowed (MastodonResult Relationship)
| AppRegistered (MastodonResult AppRegistration)
| AutoSearch (MastodonResult (List Account))
| ContextLoaded Status (MastodonResult Context)
| CurrentUser (MastodonResult Account)
| FavoriteAdded (MastodonResult Status)
| FavoriteRemoved (MastodonResult Status)
| GlobalTimeline Bool (MastodonResult (List Status))
| LocalTimeline Bool (MastodonResult (List Status))
| Notifications (MastodonResult (List Notification))
| Reblogged (MastodonResult Status)
| StatusDeleted (MastodonResult Int)
| StatusPosted (MastodonResult Status)
| Unreblogged (MastodonResult Status)
| UserTimeline Bool (MastodonResult (List Status))
type WebSocketMsg
@ -70,6 +75,7 @@ type Msg
| FilterNotifications NotificationFilter
| FollowAccount Int
| LoadAccount Int
| LoadNext Timeline
| MastodonEvent MastodonMsg
| NoOp
| OpenThread Status
@ -90,14 +96,6 @@ type Msg
| WebSocketEvent WebSocketMsg
type alias AccountViewInfo =
{ account : Account
, timeline : List Status
, folowers : List Account
, following : List Account
}
type CurrentView
= -- Basically, what we should be displaying in the fourth column
AccountFollowersView Account (List Account)
@ -152,14 +150,21 @@ type alias Viewer =
}
type alias Timeline =
{ id : String
, statuses : List Status
, links : Links
}
type alias Model =
{ server : String
, registration : Maybe AppRegistration
, client : Maybe Client
, userTimeline : List Status
, localTimeline : List Status
, globalTimeline : List Status
, accountTimeline : List Status
, userTimeline : Timeline
, localTimeline : Timeline
, globalTimeline : Timeline
, accountTimeline : Timeline
, accountFollowers : List Account
, accountFollowing : List Account
, accountRelationships : List Relationship

11
src/View/Account.elm
View File

@ -122,18 +122,21 @@ accountFollowView currentUser accounts relationships relationship account =
List.map keyedEntry accounts
accountTimelineView : CurrentUser -> List Status -> CurrentUserRelation -> Account -> Html Msg
accountTimelineView currentUser statuses relationship account =
accountTimelineView : CurrentUser -> Timeline -> CurrentUserRelation -> Account -> Html Msg
accountTimelineView currentUser timeline relationship account =
let
keyedEntry status =
( toString status.id
, li [ class "list-group-item status" ]
[ Lazy.lazy2 statusView "account" status ]
)
entries =
List.map keyedEntry timeline.statuses
in
accountView currentUser account relationship <|
Keyed.ul [ class "list-group" ] <|
List.map keyedEntry statuses
Keyed.ul [ id timeline.id, class "list-group" ] <|
(entries ++ [ ( "load-more", Common.loadMoreBtn timeline ) ])
accountView : CurrentUser -> Account -> CurrentUserRelation -> Html Msg -> Html Msg

69
src/View/App.elm
View File

@ -27,23 +27,56 @@ type alias CurrentUserRelation =
Maybe Relationship
timelineView : ( String, String, String, CurrentUser, List Status ) -> Html Msg
timelineView ( label, iconName, context, currentUser, statuses ) =
timelineView : ( String, String, CurrentUser, Timeline ) -> Html Msg
timelineView ( label, iconName, currentUser, timeline ) =
let
keyedEntry status =
( toString id, statusEntryView context "" currentUser status )
( toString id, statusEntryView timeline.id "" currentUser status )
entries =
List.map keyedEntry timeline.statuses
in
div [ class "col-md-3 column" ]
[ div [ class "panel panel-default" ]
[ a
[ href "", onClickWithPreventAndStop <| ScrollColumn ScrollTop context ]
[ href "", onClickWithPreventAndStop <| ScrollColumn ScrollTop timeline.id ]
[ div [ class "panel-heading" ] [ Common.icon iconName, text label ] ]
, Keyed.ul [ id context, class "list-group timeline" ] <|
List.map keyedEntry statuses
, Keyed.ul [ id timeline.id, class "list-group timeline" ] <|
(entries ++ [ ( "load-more", Common.loadMoreBtn timeline ) ])
]
]
userTimelineView : CurrentUser -> Timeline -> Html Msg
userTimelineView currentUser timeline =
Lazy.lazy timelineView
( "Home timeline"
, "home"
, currentUser
, timeline
)
localTimelineView : CurrentUser -> Timeline -> Html Msg
localTimelineView currentUser timeline =
Lazy.lazy timelineView
( "Local timeline"
, "th-large"
, currentUser
, timeline
)
globalTimelineView : CurrentUser -> Timeline -> Html Msg
globalTimelineView currentUser timeline =
Lazy.lazy timelineView
( "Global timeline"
, "globe"
, currentUser
, timeline
)
sidebarView : Model -> Html Msg
sidebarView model =
div [ class "col-md-3 column" ]
@ -61,13 +94,7 @@ homepageView model =
Just currentUser ->
div [ class "row" ]
[ Lazy.lazy sidebarView model
, Lazy.lazy timelineView
( "Home timeline"
, "home"
, "home"
, currentUser
, model.userTimeline
)
, userTimelineView currentUser model.userTimeline
, Lazy.lazy3
notificationListView
currentUser
@ -75,22 +102,10 @@ homepageView model =
model.notifications
, case model.currentView of
LocalTimelineView ->
Lazy.lazy timelineView
( "Local timeline"
, "th-large"
, "local"
, currentUser
, model.localTimeline
)
localTimelineView currentUser model.localTimeline
GlobalTimelineView ->
Lazy.lazy timelineView
( "Global timeline"
, "globe"
, "global"
, currentUser
, model.globalTimeline
)
globalTimelineView currentUser model.globalTimeline
AccountView account ->
accountTimelineView

17
src/View/Common.elm
View File

@ -5,6 +5,7 @@ module View.Common
, closeablePanelheading
, icon
, justifiedButtonGroup
, loadMoreBtn
)
import Html exposing (..)
@ -78,3 +79,19 @@ justifiedButtonGroup : String -> List (Html Msg) -> Html Msg
justifiedButtonGroup cls buttons =
div [ class <| "btn-group btn-group-justified " ++ cls ] <|
List.map (\b -> div [ class "btn-group" ] [ b ]) buttons
loadMoreBtn : Timeline -> Html Msg
loadMoreBtn timeline =
case timeline.links.next of
Just next ->
li [ class "list-group-item load-more text-center" ]
[ a
[ href next
, onClickWithPreventAndStop <| LoadNext timeline
]
[ text "Load more" ]
]
Nothing ->
text ""

8
tests/Main.elm
View File

@ -1,13 +1,19 @@
port module Main exposing (..)
import MastodonTest.HelperTest
import MastodonTest.HttpTest
import Test
import Test.Runner.Node exposing (run, TestProgram)
import Json.Encode exposing (Value)
main : TestProgram
main =
run emit MastodonTest.HelperTest.all
run emit <|
Test.concat
[ MastodonTest.HelperTest.all
, MastodonTest.HttpTest.all
]
port emit : ( String, Value ) -> Cmd msg

62
tests/MastodonTest/HttpTest.elm Normal file
View File

@ -0,0 +1,62 @@
module MastodonTest.HttpTest exposing (..)
import Dict
import Test exposing (..)
import Expect
import Mastodon.Http exposing (..)
all : Test
all =
describe "Mastodon.Http"
[ describe "extractLinks"
[ test "should handle absence of link header" <|
\() ->
extractLinks (Dict.fromList [])
|> Expect.equal { prev = Nothing, next = Nothing }
, test "should parse a link header" <|
\() ->
let
headers =
Dict.fromList
[ ( "link", "<nextLinkUrl>; rel=\"next\", <prevLinkUrl>; rel=\"prev\"" )
]
in
extractLinks headers
|> Expect.equal { prev = Just "prevLinkUrl", next = Just "nextLinkUrl" }
, test "should handle link header name case appropriately" <|
\() ->
let
headers =
Dict.fromList
[ ( "Link", "<nextLinkUrl>; rel=\"next\", <prevLinkUrl>; rel=\"prev\"" )
]
in
extractLinks headers
|> Expect.equal { prev = Just "prevLinkUrl", next = Just "nextLinkUrl" }
, test "should extract a single prev link" <|
\() ->
let
headers =
Dict.fromList [ ( "link", "<prevLinkUrl>; rel=\"prev\"" ) ]
in
extractLinks headers
|> Expect.equal { prev = Just "prevLinkUrl", next = Nothing }
, test "should extract a single next link" <|
\() ->
let
headers =
Dict.fromList [ ( "link", "<nextLinkUrl>; rel=\"next\"" ) ]
in
extractLinks headers
|> Expect.equal { prev = Nothing, next = Just "nextLinkUrl" }
, test "should only extract prev and next links" <|
\() ->
let
headers =
Dict.fromList [ ( "link", "<nextLinkUrl>; rel=\"next\", <blurp>; rel=\"blop\"" ) ]
in
extractLinks headers
|> Expect.equal { prev = Nothing, next = Just "nextLinkUrl" }
]
]

1
tests/elm-package.json
View File

@ -17,6 +17,7 @@
"rtfeldman/node-test-runner": "3.0.0 <= v < 4.0.0",
"NoRedInk/elm-decode-pipeline": "3.0.0 <= v < 4.0.0",
"elm-community/dict-extra": "1.5.0 <= v < 2.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",