-- | <http://strava.github.io/api/v3/follow/>
module Strive.Actions.Friends
  ( getCurrentFriends,
    getFriends,
    getCurrentFollowers,
    getFollowers,
    getCommonFriends,
  )
where

import Network.HTTP.Types (toQuery)
import Strive.Aliases (AthleteId, Result)
import Strive.Client (Client)
import Strive.Internal.HTTP (get)
import Strive.Options
  ( GetCommonFriendsOptions,
    GetCurrentFollowersOptions,
    GetCurrentFriendsOptions,
    GetFollowersOptions,
    GetFriendsOptions,
  )
import Strive.Types (AthleteSummary)

-- | <http://strava.github.io/api/v3/follow/#friends>
getCurrentFriends ::
  Client -> GetCurrentFriendsOptions -> IO (Result [AthleteSummary])
getCurrentFriends :: Client -> GetCurrentFriendsOptions -> IO (Result [AthleteSummary])
getCurrentFriends Client
client GetCurrentFriendsOptions
options = forall q j.
(QueryLike q, FromJSON j) =>
Client -> String -> q -> IO (Result j)
get Client
client String
resource Query
query
  where
    resource :: String
resource = String
"api/v3/athlete/friends"
    query :: Query
query = forall a. QueryLike a => a -> Query
toQuery GetCurrentFriendsOptions
options

-- | <http://strava.github.io/api/v3/follow/#friends>
getFriends ::
  Client -> AthleteId -> GetFriendsOptions -> IO (Result [AthleteSummary])
getFriends :: Client
-> AthleteId
-> GetCurrentFriendsOptions
-> IO (Result [AthleteSummary])
getFriends Client
client AthleteId
athleteId GetCurrentFriendsOptions
options = forall q j.
(QueryLike q, FromJSON j) =>
Client -> String -> q -> IO (Result j)
get Client
client String
resource Query
query
  where
    resource :: String
resource = String
"api/v3/athletes/" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show AthleteId
athleteId forall a. Semigroup a => a -> a -> a
<> String
"/friends"
    query :: Query
query = forall a. QueryLike a => a -> Query
toQuery GetCurrentFriendsOptions
options

-- | <http://strava.github.io/api/v3/follow/#followers>
getCurrentFollowers ::
  Client -> GetCurrentFollowersOptions -> IO (Result [AthleteSummary])
getCurrentFollowers :: Client -> GetCurrentFriendsOptions -> IO (Result [AthleteSummary])
getCurrentFollowers Client
client GetCurrentFriendsOptions
options = forall q j.
(QueryLike q, FromJSON j) =>
Client -> String -> q -> IO (Result j)
get Client
client String
resource Query
query
  where
    resource :: String
resource = String
"api/v3/athlete/followers"
    query :: Query
query = forall a. QueryLike a => a -> Query
toQuery GetCurrentFriendsOptions
options

-- | <http://strava.github.io/api/v3/follow/#followers>
getFollowers ::
  Client -> AthleteId -> GetFollowersOptions -> IO (Result [AthleteSummary])
getFollowers :: Client
-> AthleteId
-> GetCurrentFriendsOptions
-> IO (Result [AthleteSummary])
getFollowers Client
client AthleteId
athleteId GetCurrentFriendsOptions
options = forall q j.
(QueryLike q, FromJSON j) =>
Client -> String -> q -> IO (Result j)
get Client
client String
resource Query
query
  where
    resource :: String
resource = String
"api/v3/athletes/" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show AthleteId
athleteId forall a. Semigroup a => a -> a -> a
<> String
"/followers"
    query :: Query
query = forall a. QueryLike a => a -> Query
toQuery GetCurrentFriendsOptions
options

-- | <http://strava.github.io/api/v3/follow/#both>
getCommonFriends ::
  Client ->
  AthleteId ->
  GetCommonFriendsOptions ->
  IO (Result [AthleteSummary])
getCommonFriends :: Client
-> AthleteId
-> GetCurrentFriendsOptions
-> IO (Result [AthleteSummary])
getCommonFriends Client
client AthleteId
athleteId GetCurrentFriendsOptions
options = forall q j.
(QueryLike q, FromJSON j) =>
Client -> String -> q -> IO (Result j)
get Client
client String
resource Query
query
  where
    resource :: String
resource = String
"api/v3/athletes/" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show AthleteId
athleteId forall a. Semigroup a => a -> a -> a
<> String
"/both-following"
    query :: Query
query = forall a. QueryLike a => a -> Query
toQuery GetCurrentFriendsOptions
options