{-# LANGUAGE OverloadedStrings #-}

-- | The ExtraLife API is extremely simple, providing interfaces to fetch user
-- information, user donations, team information and team membership lists.
-- All reference IDs are of type Int, and non-basic types are unnecessary to
-- represent the data returned from the API.
module Web.ExtraLife.API
    (
      -- * Interfaces to the remote API
      userInfo
    , recentDonations
    , teamInfo
    , teamMembers
    ) where

import Prelude

import Network.HTTP.Client     as HC
import Network.HTTP.Client.TLS as TLS
import Data.Aeson              as Aeson
import Data.ByteString.Lazy             ( ByteString )

import Web.ExtraLife.User                   ( User )
import Web.ExtraLife.Donation               ( Donation )
import Web.ExtraLife.Team                   ( Team )
import Web.ExtraLife.TeamMember             ( TeamMember )

-- Base for all URLS comprising the ExtraLife API
elRoot :: String
elRoot :: String
elRoot = String
"https://www.extra-life.org/api/"

-- Default HTTP Client settings reasonable for most use cases
httpSettings :: HC.ManagerSettings
httpSettings :: ManagerSettings
httpSettings = ProxyOverride -> ManagerSettings -> ManagerSettings
HC.managerSetProxy (Maybe Proxy -> ProxyOverride
proxyEnvironment Maybe Proxy
forall a. Maybe a
Nothing) ManagerSettings
tlsManagerSettings

-- Sends API call, returns the response
fetchFor :: Request -> IO ByteString
fetchFor :: Request -> IO ByteString
fetchFor Request
req = do
    Manager
manager <- ManagerSettings -> IO Manager
HC.newManager ManagerSettings
httpSettings
    Response ByteString
response <- Request -> Manager -> IO (Response ByteString)
httpLbs Request
req Manager
manager
    ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
response

userInfoRaw :: Int -> String
userInfoRaw :: Int -> String
userInfoRaw = ((String
elRoot String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"participants/") String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show

recentDonationsRaw :: Int -> String
recentDonationsRaw :: Int -> String
recentDonationsRaw = (((String
elRoot String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"participants/") String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/donations")) (String -> String) -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show

teamInfoRaw :: Int -> String
teamInfoRaw :: Int -> String
teamInfoRaw = ((String
elRoot String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"teams/") String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show

teamMembersRaw :: Int -> String
teamMembersRaw :: Int -> String
teamMembersRaw = (((String
elRoot String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"teams/") String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/participants")) (String -> String) -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show

userInfo' :: Int -> Request
userInfo' :: Int -> Request
userInfo' = String -> Request
parseRequest_ (String -> Request) -> (Int -> String) -> Int -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
userInfoRaw

recentDonations' :: Int -> Request
recentDonations' :: Int -> Request
recentDonations' = String -> Request
parseRequest_ (String -> Request) -> (Int -> String) -> Int -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
recentDonationsRaw

teamInfo' :: Int -> Request
teamInfo' :: Int -> Request
teamInfo' = String -> Request
parseRequest_ (String -> Request) -> (Int -> String) -> Int -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
teamInfoRaw

teamMembers' :: Int -> Request
teamMembers' :: Int -> Request
teamMembers' = String -> Request
parseRequest_ (String -> Request) -> (Int -> String) -> Int -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
teamMembersRaw

-- | Fetches a given user's information, given a UID
userInfo :: Int -> IO (Maybe User)
userInfo :: Int -> IO (Maybe User)
userInfo Int
u = do
    ByteString
user <- Request -> IO ByteString
fetchFor (Request -> IO ByteString) -> Request -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Request
userInfo' Int
u
    Maybe User -> IO (Maybe User)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Maybe User
forall a. FromJSON a => ByteString -> Maybe a
Aeson.decode ByteString
user :: Maybe User)

-- | Fetches all recent donations for a given user
recentDonations :: Int -> IO (Maybe [Donation])
recentDonations :: Int -> IO (Maybe [Donation])
recentDonations Int
u = do
    ByteString
user <- Request -> IO ByteString
fetchFor (Request -> IO ByteString) -> Request -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Request
recentDonations' Int
u
    Maybe [Donation] -> IO (Maybe [Donation])
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Maybe [Donation]
forall a. FromJSON a => ByteString -> Maybe a
Aeson.decode ByteString
user :: Maybe [Donation])

-- | Fetches all information about a team except for members, given a Team ID
teamInfo :: Int -> IO (Maybe Team)
teamInfo :: Int -> IO (Maybe Team)
teamInfo Int
t = do
    ByteString
team <- Request -> IO ByteString
fetchFor (Request -> IO ByteString) -> Request -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Request
teamInfo' Int
t
    Maybe Team -> IO (Maybe Team)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Maybe Team
forall a. FromJSON a => ByteString -> Maybe a
Aeson.decode ByteString
team :: Maybe Team)

-- | Fetches members of a team, if any, given a Team ID
teamMembers :: Int -> IO (Maybe [TeamMember])
teamMembers :: Int -> IO (Maybe [TeamMember])
teamMembers Int
t = do
    ByteString
team <- Request -> IO ByteString
fetchFor (Request -> IO ByteString) -> Request -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Request
teamMembers' Int
t
    Maybe [TeamMember] -> IO (Maybe [TeamMember])
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Maybe [TeamMember]
forall a. FromJSON a => ByteString -> Maybe a
Aeson.decode ByteString
team :: Maybe [TeamMember])