-- | <http://strava.github.io/api/v3/clubs/>
module Strive.Actions.Clubs
  ( getClub,
    getCurrentClubs,
    getClubMembers,
    getClubActivities,
    joinClub,
    leaveClub,
  )
where

import Data.ByteString.Char8 (unpack)
import Data.ByteString.Lazy (toStrict)
import Network.HTTP.Client (responseBody, responseStatus)
import Network.HTTP.Types (Query, methodPost, ok200, toQuery)
import Strive.Aliases (ClubId, Result)
import Strive.Client (Client)
import Strive.Internal.HTTP (buildRequest, get, performRequest)
import Strive.Options (GetClubActivitiesOptions, GetClubMembersOptions)
import Strive.Types
  ( ActivitySummary,
    AthleteSummary,
    ClubDetailed,
    ClubSummary,
  )

-- | <http://strava.github.io/api/v3/clubs/#get-details>
getClub :: Client -> ClubId -> IO (Result ClubDetailed)
getClub :: Client -> ClubId -> IO (Result ClubDetailed)
getClub Client
client ClubId
clubId = 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/clubs/" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show ClubId
clubId
    query :: Query
query = [] :: Query

-- | <http://strava.github.io/api/v3/clubs/#get-athletes>
getCurrentClubs :: Client -> IO (Result [ClubSummary])
getCurrentClubs :: Client -> IO (Result [ClubSummary])
getCurrentClubs Client
client = 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/clubs"
    query :: Query
query = [] :: Query

-- | <http://strava.github.io/api/v3/clubs/#get-members>
getClubMembers ::
  Client -> ClubId -> GetClubMembersOptions -> IO (Result [AthleteSummary])
getClubMembers :: Client
-> ClubId -> GetClubMembersOptions -> IO (Result [AthleteSummary])
getClubMembers Client
client ClubId
clubId GetClubMembersOptions
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/clubs/" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show ClubId
clubId forall a. Semigroup a => a -> a -> a
<> String
"/members"
    query :: Query
query = forall a. QueryLike a => a -> Query
toQuery GetClubMembersOptions
options

-- | <http://strava.github.io/api/v3/clubs/#get-activities>
getClubActivities ::
  Client ->
  ClubId ->
  GetClubActivitiesOptions ->
  IO (Result [ActivitySummary])
getClubActivities :: Client
-> ClubId
-> GetClubActivitiesOptions
-> IO (Result [ActivitySummary])
getClubActivities Client
client ClubId
clubId GetClubActivitiesOptions
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/clubs/" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show ClubId
clubId forall a. Semigroup a => a -> a -> a
<> String
"/activities"
    query :: Query
query = forall a. QueryLike a => a -> Query
toQuery GetClubActivitiesOptions
options

-- | <http://strava.github.io/api/v3/clubs/#join>
joinClub :: Client -> ClubId -> IO (Result ())
joinClub :: Client -> ClubId -> IO (Result ())
joinClub Client
client ClubId
clubId = do
  Request
request <- forall q.
QueryLike q =>
ByteString -> Client -> String -> q -> IO Request
buildRequest ByteString
methodPost Client
client String
resource Query
query
  Response ByteString
response <- Client -> Request -> IO (Response ByteString)
performRequest Client
client Request
request
  forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ( if forall body. Response body -> Status
responseStatus Response ByteString
response forall a. Eq a => a -> a -> Bool
== Status
ok200
        then forall a b. b -> Either a b
Right ()
        else forall a b. a -> Either a b
Left (Response ByteString
response, (ByteString -> String
unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall body. Response body -> body
responseBody) Response ByteString
response)
    )
  where
    resource :: String
resource = String
"api/v3/clubs/" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show ClubId
clubId forall a. Semigroup a => a -> a -> a
<> String
"/join"
    query :: Query
query = [] :: Query

-- | <http://strava.github.io/api/v3/clubs/#leave>
leaveClub :: Client -> ClubId -> IO (Result ())
leaveClub :: Client -> ClubId -> IO (Result ())
leaveClub Client
client ClubId
clubId = do
  Request
request <- forall q.
QueryLike q =>
ByteString -> Client -> String -> q -> IO Request
buildRequest ByteString
methodPost Client
client String
resource Query
query
  Response ByteString
response <- Client -> Request -> IO (Response ByteString)
performRequest Client
client Request
request
  forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ( if forall body. Response body -> Status
responseStatus Response ByteString
response forall a. Eq a => a -> a -> Bool
== Status
ok200
        then forall a b. b -> Either a b
Right ()
        else forall a b. a -> Either a b
Left (Response ByteString
response, (ByteString -> String
unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall body. Response body -> body
responseBody) Response ByteString
response)
    )
  where
    resource :: String
resource = String
"api/v3/clubs/" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show ClubId
clubId forall a. Semigroup a => a -> a -> a
<> String
"/leave"
    query :: Query
query = [] :: Query