{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE AutoDeriveTypeable #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE LambdaCase #-} -- | Internal operations of the Betfair API. -- module Network.Betfair.Internal ( -- * Login procedures LoginResponse(..) , SessionKey -- * API call limit -- -- | I really advice against using these from user code. , NumberOfRequests , rateLimit , workRateLimit -- * Requests , Request(..) -- ** Betfair URLs , bettingUrl , heartbeatUrl , Url ) where import Control.Applicative import Control.Concurrent import Control.Monad import Control.Monad.Catch import Data.Aeson import Data.IORef import Data.Text ( Text ) import Data.Typeable import System.IO.Unsafe type SessionKey = Text data LoginResponse = LoginFailed Text | LoginSuccessful SessionKey deriving ( Eq, Ord, Show, Read, Typeable ) instance FromJSON LoginResponse where parseJSON (Object v) = v .: "loginStatus" >>= \case "SUCCESS" -> LoginSuccessful <$> v .: "sessionToken" notsuccess -> return $ LoginFailed notsuccess parseJSON _ = empty ---- The rate limiter ---- type NumberOfRequests = Double rateLimit :: IORef NumberOfRequests rateLimit = unsafePerformIO $ newIORef 4 {-# NOINLINE rateLimit #-} ---- The lock used to limit the number of API calls --- -- | Call before you request anything from Betfair, the locking system makes -- sure this cannot be called too many times per second. workRateLimit :: IO () workRateLimit = mask_ $ do modifyMVar_ workRateThreadMVar $ \case Nothing -> Just <$> forkIO workRateThread x -> return x takeMVar workRateLock workRateLock :: MVar () workRateLock = unsafePerformIO $ newEmptyMVar {-# NOINLINE workRateLock #-} workRateThreadMVar :: MVar (Maybe ThreadId) workRateThreadMVar = unsafePerformIO $ newMVar Nothing {-# NOINLINE workRateThread #-} workRateThread :: IO () workRateThread = forever $ do putMVar workRateLock () x <- readIORef rateLimit if x <= 0 then forever $ threadDelay 10000000 else when (x > 0) $ threadDelay $ ceiling $ (1000000 :: Double) / x type Url = String bettingUrl :: Url bettingUrl = "https://api.betfair.com/exchange/betting/json-rpc/v1" heartbeatUrl :: Url heartbeatUrl = "https://api.betfair.com/exchange/heartbeat/json-rpc/v1" -- | Class of types that can be used as requests to Betfair, with their -- response defined as the second type variable. class (ToJSON a, FromJSON b) => Request a b | a -> b where requestMethod :: Proxy a -> Text requestUrl :: Proxy a -> Url