bet (empty) → 0.1.0.0
raw patch · 12 files changed
+2156/−0 lines, 12 filesdep +HsOpenSSLdep +QuickCheckdep +aesonsetup-changed
Dependencies added: HsOpenSSL, QuickCheck, aeson, base, bet, bifunctors, bytestring, containers, exceptions, http-client-openssl, lens, mtl, pipes, pipes-http, semigroupoids, semigroups, test-framework, test-framework-quickcheck2, test-framework-th, text, time
Files
- LICENSE +20/−0
- Setup.hs +2/−0
- bet.cabal +99/−0
- src/Data/Bet.hs +251/−0
- src/Network/Betfair.hs +320/−0
- src/Network/Betfair/Internal.hs +99/−0
- src/Network/Betfair/Types.hs +1179/−0
- src/Network/Betfair/Types/TH.hs +44/−0
- src/Network/Betfair/Unsafe.hs +35/−0
- test/DataBet.hs +61/−0
- test/Main.hs +8/−0
- toys/login-test/Main.hs +38/−0
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2014 Mikko Juola++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ bet.cabal view
@@ -0,0 +1,99 @@+name: bet+version: 0.1.0.0+synopsis: Betfair API bindings. Bet on sports on betting exchanges.+description:+ This library contains Haskell bindings to the Betfair API.+ .+ <https://developer.betfair.com/default/api-s-and-services/sports-api/sports-overview/>+ .+ At the moment, the \'Betting API\' and \'Heartbeat API\' is implemented.+ The \'Accounts API\' is not.+ .+ See "Network.Betfair".+ .+ CAUTION: These are experimental bindings. Because of the financially+ dangerous nature of betting, I advice you to have a contingency plan if+ something in the library breaks down.+ .+ In particular, check the Betfair API documentation page for which version+ it is at the moment. This library is written against version 2.0 exactly.+ .+ This library enforces limits on the number of calls you can do to Betfair+ API in a second, to help you avoid data charges. See+ "Network.Betfair.Unsafe".+homepage: https://github.com/Noeda/hs-bet/+license: MIT+license-file: LICENSE+author: Mikko Juola+maintainer: mikjuo@gmail.com+copyright: Copyright (C) 2014 Mikko Juola+category: Network+build-type: Simple+stability: experimental+cabal-version: >=1.10++flag toys+ description: Build toys; to test if things work+ default: False++source-repository head+ type: git+ location: https://github.com/Noeda/bet.git++library+ exposed-modules: Data.Bet+ Network.Betfair+ Network.Betfair.Types+ Network.Betfair.Types.TH+ Network.Betfair.Unsafe++ other-modules: Network.Betfair.Internal++ build-depends: aeson >=0.8.0.2 && <1.0+ ,base >=4.7 && <5.0+ ,bifunctors >=4.2 && <5.0+ ,bytestring >=0.10 && <1.0+ ,containers >=0.5 && <1.0+ ,exceptions >=0.6 && <1.0+ ,HsOpenSSL >=0.11 && <1.0+ ,http-client-openssl >=0.2 && <1.0+ ,lens >=4.6 && <5.0+ ,mtl >=2.1 && <3.0+ ,pipes >=4.1.3 && <5.0+ ,pipes-http >=1.0.1 && <2.0+ ,semigroups >=0.15.4 && <1.0+ ,semigroupoids >=4.2 && <5.0+ ,text >=1.2 && <2.0+ ,time >=1.4 && <1.5+ ghc-options: -Wall+ hs-source-dirs: src+ default-language: Haskell2010++test-suite properties+ type: exitcode-stdio-1.0+ main-is: Main.hs+ other-modules: DataBet+ hs-source-dirs: test+ ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+ build-depends: base+ ,bet+ ,lens >=4.6 && <5.0+ ,QuickCheck >=2.7.6 && <3.0+ ,semigroups >=0.15.4 && <1.0+ ,test-framework >=0.8.0.3 && <1.0+ ,test-framework-quickcheck2 >=0.3.0.3 && <1.0+ ,test-framework-th >=0.2.4 && <1.0+ default-language: Haskell2010++executable login-test+ if flag(toys)+ build-depends: base+ ,bet+ else+ buildable: False++ main-is: Main.hs+ ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+ hs-source-dirs: toys/login-test+ default-language: Haskell2010+
+ src/Data/Bet.hs view
@@ -0,0 +1,251 @@+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE AutoDeriveTypeable #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE CPP #-}++-- | Data types and functions to work with odds and stakes.+--++module Data.Bet+ (+ -- * Bets+ BetType(..)+ , oppositeBetType+ , betBool+ , Bet(..)+ , BetFlipped(..)+ , betType+ , odds+ , stake+ -- ** Derived lenses+ -- | The values these lenses manipulate are calculated on the fly and not+ -- stored directly. These may not necessarily follow lens laws with 100%+ -- accuracy but only because there are inaccuracies in floating point+ -- numerical values.+ , liability+ , winningPotential+ -- ** Pattern synonyms+ , pattern BetType+ , pattern BetLiability+ , pattern BetWinningPotential+ -- * Choosing stakes+ , bestTradingStake+ , bestTradingStake2+ )+ where++import Control.Applicative+import Control.Lens+import Data.Aeson+import Data.Bifoldable+import Data.Bitraversable+import Data.Foldable+import Data.Semigroup+import Data.Semigroup.Foldable+import Data.Semigroup.Bifoldable+import Data.Traversable+import Data.Typeable++-- | A bet type. In a betting exchange, you usually can choose if you want to+-- make a back or lay bet. With traditional bookmakers, you usually only back.+data BetType = Back | Lay+ deriving ( Eq, Ord, Show, Read, Typeable, Enum )++-- | An `Iso` from `BetType` to `Bool`.+betBool :: Iso' BetType Bool+betBool = iso (\case+ Back -> False+ Lay -> True)+ (\case+ False -> Back+ True -> Lay)+{-# INLINEABLE betBool #-}++-- | Returns the opposite bet type.+oppositeBetType :: BetType -> BetType+oppositeBetType Back = Lay+oppositeBetType Lay = Back++-- | Describes a bet in terms of its (European) odds and the stake size.+--+-- @+-- Bet odds money = Bet BetType odds money+-- ^ ^+-- | |+-- | +--- Data type of the money to use.+-- |+-- +-- Describes the data type used as odds.+-- Some betting environments don't allow just any odds so+-- it may be useful to use this type variable to restrict+-- available odds.+-- @+--+data Bet odds money = Bet !BetType odds money+ deriving ( Traversable+ , Foldable+ , Typeable+ , Functor+ , Read+ , Show+ , Ord+ , Eq )++instance Foldable1 (Bet odds)+instance Bifoldable1 Bet++instance Bifoldable Bet where+ bifoldMap f g (Bet _ o m) = f o `mappend` g m+ {-# INLINEABLE bifoldMap #-}++instance Bitraversable Bet where+ bitraverse f g (Bet t o m) = Bet t <$> f o <*> g m++instance (Semigroup odds, Semigroup money) => Semigroup (Bet odds money) where+ b1 <> b2 = b1 & (stake %~ (<> b2^.stake)) .+ (odds %~ (<> b2^.odds))++instance Bifunctor Bet where+ bimap fun1 fun2 = (odds %~ fun1) . (stake %~ fun2)+ {-# INLINEABLE bimap #-}++-- | A wrapper to use odds as last type argument.+newtype BetFlipped money odds = BetFlipped { getFlipped :: Bet odds money }+ deriving ( Typeable+ , Read+ , Show+ , Ord+ , Eq )++instance Functor (BetFlipped money) where+ fmap f (getFlipped -> Bet t o m) = BetFlipped $ Bet t (f o) m++instance Foldable (BetFlipped money) where+ foldMap f (getFlipped -> Bet _ o _) = f o+ foldr f r (getFlipped -> Bet _ o _) = f o r++instance Traversable (BetFlipped money) where+ traverse f (getFlipped -> bet) =+ BetFlipped . (\x -> bet & odds .~ x) <$> f (bet^.odds)+ sequenceA (getFlipped -> Bet t o m) =+ BetFlipped <$> (Bet t <$> o <*> pure m)++instance (Semigroup odds, Semigroup money)+ => Semigroup (BetFlipped money odds) where+ (getFlipped -> b1) <> (getFlipped -> b2) =+ BetFlipped $ b1 <> b2++instance Bifunctor BetFlipped where+ bimap fun2 fun1 (getFlipped -> b) =+ BetFlipped $ b & (odds %~ fun1) . (stake %~ fun2)+ {-# INLINEABLE bimap #-}++instance Bifoldable BetFlipped where+ bifoldMap f g (getFlipped -> Bet _ o m) = g o `mappend` f m++instance Bifoldable1 BetFlipped++instance Bitraversable BetFlipped where+ bitraverse f g (getFlipped -> Bet t o m) =+ BetFlipped <$> (Bet t <$> g o <*> f m)++instance Foldable1 (BetFlipped money)++odds :: Lens (Bet odds1 money) (Bet odds2 money) odds1 odds2+odds = lens (\(Bet _ o _) -> o)+ (\(Bet t _ m) o -> Bet t o m)+{-# INLINEABLE odds #-}++stake :: Lens (Bet odds money1) (Bet odds money2) money1 money2+stake = lens (\(Bet _ _ m) -> m)+ (\(Bet t o _) m -> Bet t o m)+{-# INLINEABLE stake #-}++betType :: Lens' (Bet odds money) BetType+betType = lens (\(Bet t _ _) -> t)+ (\(Bet _ o m) t -> Bet t o m)+{-# INLINEABLE betType #-}++-- | Liability is the amount of money you stand to lose for a bet if you lose+-- it.+--+-- For back bets, liability equals stake. For lay bets, liability is stake+-- multiplied by (odds-1).+--+-- An unfortunate flaw of this function: odds and money data types need to be+-- the same.+liability :: (Fractional odds, odds ~ money) => Lens' (Bet odds money) money+liability = lens getLiability setLiability+{-# INLINEABLE liability #-}++setLiability :: (Fractional odds, odds ~ money)+ => Bet odds money -> money -> Bet odds money+setLiability bet@(BetType Back) new_m = bet & stake .~ new_m+setLiability bet@(Bet Lay o _) new_l = bet & stake .~ new_l/(o-1)+setLiability _ _ = error "setLiability: impossible"++getLiability :: (Num odds, odds ~ money) => Bet odds money -> money+getLiability (Bet Back _ m) = m+getLiability (Bet Lay o m) = m*(o-1)++-- | Winning potential tells you how much you could win if this bet pays.+--+-- This is profit value. If you back bet 5 dollars at odds 2.0 then your+-- winning potential is 5 dollars. (You will have 10 dollars if you started+-- with 5 dollars).+winningPotential :: (Fractional odds, odds ~ money)+ => Lens' (Bet odds money) money+winningPotential = lens getWinningPotential setWinningPotential++getWinningPotential :: (Num odds, odds ~ money) => Bet odds money -> money+getWinningPotential (Bet Back o m) = (o-1) * m+getWinningPotential (Bet Lay _ m) = m++setWinningPotential :: (Fractional odds, odds ~ money)+ => Bet odds money -> money -> Bet odds money+setWinningPotential bet@(BetType Back) new_w =+ bet & stake .~ new_w / (bet^.odds - 1)+setWinningPotential bet new_w =+ bet & stake .~ new_w++-- | Match the bet type only.+pattern BetType b <- Bet b _ _+-- | Match with liability.+pattern BetLiability b o l <- Bet b o (getLiability -> l)+-- | Match with winning potential.+pattern BetWinningPotential b o w <- Bet b o (getWinningPotential -> w)++-- | Given a bet and opposing bet odds, calculates the ideal stake size to+-- minimize potential loss.+--+-- This is useful in bet trading, which gives this function its name.+bestTradingStake :: ( Fractional odds, odds ~ money )+ => Bet odds money -> odds -> money+bestTradingStake (Bet bt o m) opposing_odds = case bt of+ Back -> o*m / opposing_odds+ Lay -> m*o / opposing_odds++-- | Same as `bestTradingStake` but wraps the result in a new bet.+bestTradingStake2 :: ( Fractional odds, odds ~ money )+ => Bet odds money -> odds -> Bet odds money+bestTradingStake2 bet opposing_odds =+ Bet (oppositeBetType $ bet^.betType)+ opposing_odds+ (bestTradingStake bet opposing_odds)++instance FromJSON BetType where+ parseJSON (String "BACK") = pure Back+ parseJSON (String "LAY") = pure Lay+ parseJSON _ = empty++instance ToJSON BetType where+ toJSON Back = String "BACK"+ toJSON Lay = String "LAY"+
+ src/Network/Betfair.hs view
@@ -0,0 +1,320 @@+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE AutoDeriveTypeable #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE LambdaCase #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}++-- | API to Betfair (<http://www.betfair.com>).+--+-- You need a Betfair account, API keys and registered SSL certificates to use+-- this module.+--+-- Using the API may subject you to data charges:+--+-- <http://www.betfair.com/aboutUs/Betfair.Charges/>+--+-- By default this library will not let you do more than 4 requests per second.+-- This limit is global and is enforced even if you have multiple Betfair+-- connections.+--+-- This should stop you from being able to do anything that incurs data charges+-- by API use only (you can still ruin yourself by making bad bets), even the+-- heavily weighted charges.+--+-- Use `request` to make calls to Betfair. Look at "Network.Betfair.Types" for+-- commands to use with `request`.+--++module Network.Betfair+ (+ -- * Credentials+ Credentials(..)+ , HasCredentials(..)+ -- * Connection+ , openBetfair+ , closeBetfair+ , Betfair()+ -- * Operations+ , request+ , Network.Betfair.Internal.Request()+ -- * Types+ , module Network.Betfair.Types )+ where++import Control.Applicative+import Control.Concurrent+import Control.Lens hiding ( (.=) )+import Control.Monad.Catch+import Control.Monad.State.Strict+import Data.Aeson+import Data.ByteString ( ByteString )+import qualified Data.ByteString as B+import qualified Data.ByteString.Builder as BL+import qualified Data.ByteString.Lazy as BL+import Data.IORef+import Data.Monoid+import Data.Proxy+import Data.Text ( Text )+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import Data.Typeable+import Network.Betfair.Internal+import Network.Betfair.Types+import Network.HTTP.Client.OpenSSL+import OpenSSL.Session+import Pipes hiding ( Proxy )+import Pipes.HTTP as PH hiding ( Proxy )+import System.Mem.Weak++-- | Login credentials.+data Credentials = Credentials {+ _username :: Text -- ^ Your Betfair username.+ , _password :: Text -- ^ Your Betfair password.+ , _certificatePrivateKeyFile :: FilePath+ , _certificateCertificateFile :: FilePath+ , _apiKey :: Text }+ deriving ( Eq, Ord, Show, Read, Typeable )+makeClassy ''Credentials++data Work = Work !Url !JsonRPCQuery !(MVar (Either SomeException BL.ByteString))+ deriving ( Eq, Typeable )++-- The type of all JSON-based queries sent out+data JsonRPCQuery = JsonRPCQuery+ { params :: !Value+ , methodName :: !Text }+ deriving ( Eq, Show, Typeable )++-- The type of all JSON-based queries received+newtype JsonRPC a = JsonRPC (Either APIException a)++data BetfairHandle = BetfairHandle+ { _betfairThread :: !ThreadId+ , _workChannel :: !(MVar Work) }+makeClassy ''BetfairHandle++instance FromJSON a => FromJSON (JsonRPC a) where+ parseJSON (Object v) = JsonRPC <$>+ msum [ Right <$> v .: "result"+ , do err <- v .: "error"+ dt <- err .: "data"+ exc <- dt .: "APINGException"+ details <- exc .: "errorDetails"+ code <- exc .: "errorCode"+ return $ Left $ APIException details code ]+ parseJSON _ = empty++instance ToJSON JsonRPCQuery where+ toJSON (JsonRPCQuery {..}) =+ object [ "jsonrpc" .= ("2.0" :: Text)+ , "method" .= methodName+ , "id" .= (1 :: Int)+ , "params" .= params ]++-- | A handle to a Betfair connection.+newtype Betfair = Betfair (MVar (Maybe BetfairHandle))+ deriving ( Eq, Typeable )++-- | Connect to Betfair with given credentials.+--+-- The connection is cut when the returned `Betfair` value is garbage collected+-- or closed with `closeBetfair`.+openBetfair :: MonadIO m => Credentials -> m Betfair+openBetfair credentials = liftIO $ mask_ $ do+ -- MVars. MVars everywhere.+ semaphore <- newEmptyMVar+ work_mvar <- newEmptyMVar+ weak_mvar_mvar <- newEmptyMVar++ bftid <- forkIOWithUnmask $ \unmask ->+ -- catch `CloseBetfair` to suppress message+ flip catch (\CloseBetfair -> return ()) $ do+ withOpenSSL $ do+ weak_mvar <- takeMVar weak_mvar_mvar+ finally+ (unmask $ betfairConnection credentials semaphore work_mvar)+ (deRefWeak weak_mvar >>= \case+ Nothing -> return ()+ Just mvar -> modifyMVar_ mvar $ \_ -> return Nothing)++ let handle = BetfairHandle { _betfairThread = bftid+ , _workChannel = work_mvar }++ mvar <- newEmptyMVar+ weak_mvar <- mkWeakMVar mvar $ closeBetfairHandle handle+ putMVar weak_mvar_mvar weak_mvar++ flip onException (killThread bftid) $+ takeMVar semaphore >>= \case+ Left err -> throwM err+ Right _ -> do putMVar mvar (Just handle)+ return $ Betfair mvar++withBetfair :: Betfair -> (BetfairHandle -> IO a) -> IO a+withBetfair (Betfair mvar) action = withMVar mvar $ \case+ Nothing -> throwM BetfairIsClosed+ Just bhandle -> action bhandle++work :: (FromJSON a) => Betfair -> Url -> JsonRPCQuery -> IO a+work bf url query = withBetfair bf $ \handle -> do+ result <- newEmptyMVar+ putMVar (_workChannel handle) $ Work url query result+ takeMVar result >>= \case+ Left exc -> throwM exc+ Right result -> case decode result of+ Nothing -> throwM $ ParsingFailure $ "Betfair behaved in unexpected way. Received raw string: " <> (T.pack $ show result)+ Just (JsonRPC (Left exc)) -> throwM exc+ Just (JsonRPC (Right x)) -> return x++betfairConnection :: Credentials+ -> MVar (Either SomeException ())+ -> MVar Work+ -> IO ()+-- the pattern is lazy because if it's bottom, we catch it a too early+betfairConnection ~credentials@(Credentials{..}) semaphore work_mvar =+ flip catch (\(e :: SomeException) -> putMVar semaphore (Left e)) $ do+ -- establish SSL-enabled HTTP manager+ ssl_context <- context+ contextSetPrivateKeyFile ssl_context _certificatePrivateKeyFile+ contextSetCertificateFile ssl_context _certificateCertificateFile+ withManager (opensslManagerSettings $ return ssl_context) $ \m -> do+ session_key <- obtainSessionKey credentials m+ putMVar semaphore (Right ()) -- we are ready to process API calls+ -- so signal that to `openBetfair`.+ mask $ \restore -> do+ keep_alive_tid <- forkIO $ restore $ forever $ do+ -- wait 10 hours+ -- we use a loop because Int may be too+ -- small to hold the number of+ -- microseconds needed.+ replicateM_ (3600*10) $+ threadDelay 1000000+ keepAlive session_key credentials m+ finally (restore $ workLoop session_key credentials m work_mvar)+ (killThread keep_alive_tid)++workLoop :: SessionKey -> Credentials -> Manager -> MVar Work -> IO ()+workLoop session_key credentials m work_mvar = forever $ do+ work <- takeMVar work_mvar+ case work of+ Work url sending result_mvar -> do+ flip onException (tryPutMVar result_mvar $ Left $+ toException BetfairIsClosed) $ do+ -- --- IMPORTANT API LIMIT DO NOT TOUCH --- --+ workRateLimit -- make sure we don't make too many API calls per+ -- second or we incur Betfair charges++ request <- betfairRequest session_key credentials sending url+ withHTTP request m $ \response -> do+ body <- readBodyLimited 50000000 response+ putMVar result_mvar (Right body)++betfairRequest :: SessionKey+ -> Credentials+ -> JsonRPCQuery+ -> Url+ -> IO PH.Request+betfairRequest session_key (Credentials{..}) query url = do+ req <- parseUrl url+ return $ req { method = "POST"+ , requestBody = RequestBodyBS $ BL.toStrict $ encode query+ , requestHeaders = requestHeaders req <>+ [ ("X-Application", T.encodeUtf8 _apiKey)+ , ("X-Authentication", T.encodeUtf8 session_key)+ , ("content-type", "application/json") ] }++keepAlive :: SessionKey -> Credentials -> Manager -> IO ()+keepAlive session_key (Credentials{..}) m = do+ req' <- parseUrl "https://identitysso.betfair.com/api/keepAlive"+ let req = req' { requestHeaders = requestHeaders req' <>+ [ ("Accept", "application/json")+ , ("X-Application", T.encodeUtf8 _apiKey)+ , ("X-Authentication", T.encodeUtf8 session_key) ] }+ withHTTP req m $ \response -> do+ -- maybe it works, maybe it does not? I'm not sure what would be the+ -- sensible thing to do if keep-alive request fails. User probably+ -- still can continue to use the API as long as the session key is+ -- valid (which it will be for 12 hours).+ _ <- readBodyLimited 100000 response+ return ()++obtainSessionKey :: Credentials+ -> Manager+ -> IO SessionKey+obtainSessionKey (Credentials{..}) m = do+ -- request to obtain a session key+ req' <- parseUrl "https://identitysso.betfair.com/api/certlogin"+ let req = urlEncodedBody [("username", T.encodeUtf8 _username)+ ,("password", T.encodeUtf8 _password)] $+ req' { requestHeaders = requestHeaders req' <>+ [ ("X-Application", T.encodeUtf8 _apiKey) ] }+ withHTTP req m $ \response -> do+ b <- readBodyLimited 1000000 response+ case decode b of+ Nothing -> throwM $ ParsingFailure "session key"+ Just login_response -> case login_response of+ LoginFailed reason -> throwM $ LoginFailure reason+ LoginSuccessful session_key -> return session_key++readBodyLimited :: Int+ -> Response (Producer ByteString IO ())+ -> IO BL.ByteString+readBodyLimited max_bytes response = do+ accumRef <- newIORef mempty+ runEffect $ responseBody response >-> accumulator accumRef 0+ BL.toLazyByteString <$> readIORef accumRef+ where+ accumulator accumRef builder_length = do+ block <- await+ accum <- liftIO $ readIORef accumRef+ when (B.length block + builder_length > max_bytes) $+ liftIO $ throwM TooMuchHTTPData+ liftIO $ writeIORef accumRef (accum <> BL.byteString block)+ accumulator accumRef (builder_length + B.length block)++-- | The type of exceptions that can happen with Betfair.+data BetfairException+ = TooMuchHTTPData+ -- ^ A HTTP response sent improbable amount of data.+ -- You are unlikely to see this unless Betfair+ -- is having a serious malfunction.+ | ParsingFailure Text+ -- ^ This exception is thrown if some data returned from Betfair+ -- failed to parse as expected JSON. It can mean a bug in our library+ -- or changes in the Betfair API that his library has not taken into+ -- account. The string has human-readable information.+ | LoginFailure Text+ -- ^ Login failed. The human-readable string tells why.+ | BetfairIsClosed+ -- ^ The `Betfair` handle you tried to use is closed.+ deriving ( Eq, Ord, Show, Read, Typeable )+instance Exception BetfairException++data CloseBetfair = CloseBetfair+ deriving ( Eq, Ord, Show, Read, Typeable, Enum )+instance Exception CloseBetfair++-- | Close a `Betfair` connection promptly.+--+-- Does nothing if it was already closed. Trying to use `Betfair` after this+-- call will result in a user error.+closeBetfair :: MonadIO m => Betfair -> m ()+closeBetfair (Betfair mvar) = liftIO $ modifyMVar_ mvar $ \case+ Nothing -> return Nothing+ Just handle -> closeBetfairHandle handle >> return Nothing++closeBetfairHandle :: BetfairHandle -> IO ()+closeBetfairHandle (_betfairThread -> tid) = throwTo tid CloseBetfair++-- | Perform a request to `Betfair`.+request :: forall a b m. (MonadIO m, Network.Betfair.Internal.Request a b)+ => a -> Betfair -> m b+request req bf = liftIO $+ work bf (requestUrl (Proxy :: Proxy a))+ (JsonRPCQuery { methodName = requestMethod (Proxy :: Proxy a)+ , params = toJSON req })+
+ src/Network/Betfair/Internal.hs view
@@ -0,0 +1,99 @@+{-# 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+
+ src/Network/Betfair/Types.hs view
@@ -0,0 +1,1179 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE AutoDeriveTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE QuasiQuotes #-}++-- | This module defines most data types in the betting API of Betfair API,+-- corresponding to version 2.0. Refer to Betfair API documentation for+-- meanings of the values.+--+-- <https://developer.betfair.com/default/api-s-and-services/sports-api/sports-overview/>+--+-- This module does not have a proper Haddock index so pay attention here.+--+-- Where possible, data types are in 1:1 correspondence to the ones documented+-- in the API. However, because there are name clashes, most record field names+-- are prefixed with an abbreviation of the data type they are defined in. All+-- recordful constructors have C at their end.+--+-- There are lenses for every record field, giving you overloaded fields. The+-- lens name will have the prefix stripped off and the first character+-- lowercased. For example, `cStatus` record field in `CurrentOrderSummary` has+-- a corresponding lens called `status`, implemented in `HasStatus` type class.+--+-- Records that can be used as requests implement `Request` type class. Records+-- that have some kind of sensible default implement `Default` type class.+--+-- `HasBet` is a helper typeclass for things that have a `Bet` inside them in+-- some way.+--+-- A future version of this module might use overloaded records of some kind to+-- avoid bazillion different names in record fields. Stay tuned.+--+-- As of writing of this, the whole surface area of these types have not been+-- tested. If your Betfair requests fail for mysterious reasons, it's possible+-- a field is not a `Maybe` field when it should or there is a typo somewhere.+-- Betfair's documentation does say which fields should be present but the+-- information seems to be inaccurate; leading us to speculate how exactly+-- these values work.+--++module Network.Betfair.Types where++import Control.Monad.Catch+import Control.Lens+import Data.Aeson+import Data.Aeson.TH+import Data.Bet+import Data.Text ( Text )+import Data.Time+import Data.Typeable+import qualified Data.Set as S+import qualified Data.Map.Lazy as M+import Network.Betfair.Internal+import Network.Betfair.Types.TH+import Prelude hiding ( filter, id )++data ActionPerformed+ = ANone+ | ACancellationRequestSubmitted+ | AAllBetsCancelled+ | ASomeBetsNotCancelled+ | ACancellationRequestError+ | ACancellationStatusUnknown+ deriving ( Eq, Ord, Show, Read, Typeable, Enum )++data BetStatus+ = Settled+ | Voided+ | Lapsed+ | Cancelled+ deriving ( Eq, Ord, Show, Read, Typeable, Enum )++data ExecutionReportErrorCode+ = RErrorInMatcher+ | RProcessedWithErrors+ | RBetActionError+ | RInvalidAccountState+ | RInvalidWalletStatus+ | RInsufficientFunds+ | RLossLimitExceeded+ | RMarketSuspended+ | RMarketNotOpenForBetting+ | RDuplicateTransaction+ | RInvalidOrder+ | RInvalidMarketId+ | RPermissionDenied+ | RDuplicateBetids+ | RNoActionRequired+ | RServiceUnavailable+ | RRejectedByRegulator+ deriving ( Eq, Ord, Show, Read, Typeable, Enum )++data ExecutionReportStatus+ = ESuccess+ | EFailure+ | EProcessedWithErrors+ | ETimeout+ deriving ( Eq, Ord, Show, Read, Typeable, Enum )++data GroupBy+ = GBEventType+ | GBEvent+ | GBMarket+ | GBSide+ | GBBet+ deriving ( Eq, Ord, Show, Read, Typeable, Enum )++data InstructionReportErrorCode+ = InvalidBetSize+ | InvalidRunner+ | BetTakenOrLapsed+ | BetInProgress+ | RunnerRemoved+ | MarketNotOpenForBetting+ | LossLimitExceeded+ | MarketNotOpenForBspBetting+ | InvalidPriceEdit+ | InvalidOdds+ | InsufficientFunds+ | InvalidPersistenceType+ | ErrorInMatcher+ | InvalidBackLayCombination+ | ErrorInOrder+ | InvalidBidType+ | InvalidBetId+ | CancelledNotPlaced+ | RelatedActionFailed+ | NoActionRequired+ deriving ( Eq, Ord, Show, Read, Typeable, Enum )++data InstructionReportStatus+ = Success+ | Failure+ | Timeout+ deriving ( Eq, Ord, Show, Read, Typeable, Enum )++data MarketBettingType+ = Odds+ | Line+ | Range+ | AsianHandicapDoubleLine+ | AsianHandicapSingleLine+ | FixedOdds+ deriving ( Eq, Ord, Show, Read, Typeable, Enum )++data MarketProjection+ = Competition+ | Event+ | EventType+ | MarketStartTime+ | MarketDescription+ | RunnerDescription+ | RunnerMetadata+ deriving ( Eq, Ord, Show, Read, Typeable, Enum )++data MarketSort+ = MinimumTraded+ | MaximumTraded+ | MinimumAvailable+ | MaximumAvailable+ | FirstToStart+ | LastToStart+ deriving ( Eq, Ord, Show, Read, Typeable, Enum )++data MarketStatus+ = Inactive+ | Open+ | Suspended+ | Closed+ deriving ( Eq, Ord, Show, Read, Typeable, Enum )++data MatchProjection+ = NoRollup+ | RolledUpByPrice+ | RolledUpByAvgPrice+ deriving ( Eq, Ord, Show, Read, Typeable, Enum )++data OrderBy+ = ByBet+ | ByMarket+ | ByMatchTime+ | ByPlaceTime+ | BySettledTime+ | ByVoidTime+ deriving ( Eq, Ord, Show, Read, Typeable, Enum )++data OrderProjection+ = OpAll+ | OpExecutable+ | OpExecutionComplete+ deriving ( Eq, Ord, Show, Read, Typeable, Enum )++data OrderStatus+ = ExecutionComplete+ | Executable+ deriving ( Eq, Ord, Show, Read, Typeable, Enum )++data OrderType+ = Limit+ | LimitOnClose+ | MarketOnClose+ deriving ( Eq, Ord, Show, Read, Typeable, Enum )++data PersistenceType+ = PtLapse+ | PtPersist+ | PtMarketOnClose+ deriving ( Eq, Ord, Show, Read, Typeable, Enum )++data PriceData+ = SpAvailable+ | SpTraded+ | ExBestOffers+ | ExAllOffers+ | ExTraded+ deriving ( Eq, Ord, Show, Read, Typeable, Enum )++data RollupModel+ = Stake+ | Payout+ | ManagedLiability+ | None+ deriving ( Eq, Ord, Show, Read, Typeable, Enum )++data RunnerStatus+ = Active+ | Winner+ | Loser+ | RemovedVacant+ | Removed+ | Hidden+ deriving ( Eq, Ord, Show, Read, Typeable, Enum )++type Side = BetType++data SortDir+ = EarliestToLatest+ | LatestToEarliest+ deriving ( Eq, Ord, Show, Read, Typeable, Enum )++data TimeGranularity+ = Days+ | Hours+ | Minutes+ deriving ( Eq, Ord, Show, Read, Typeable, Enum )+++newtype BetId = BetId { getBetId :: Text }+ deriving ( Eq, Ord, Show, Read, Typeable, FromJSON, ToJSON )++newtype Country = Country { getCountry :: Text }+ deriving ( Eq, Ord, Show, Read, Typeable+ , FromJSON, ToJSON )++newtype CompetitionId = CompetitionId { getCompetitionId :: Text }+ deriving ( Eq, Ord, Show, Read, Typeable+ , FromJSON, ToJSON )++newtype EventId = EventId { getEventId :: Text }+ deriving ( Eq, Ord, Show, Read, Typeable+ , FromJSON, ToJSON )++newtype EventTypeId = EventTypeId { getEventTypeId :: Text }+ deriving ( Eq, Ord, Show, Read, Typeable+ , FromJSON, ToJSON )++newtype MarketId = MarketId { getMarketId :: Text }+ deriving ( Eq, Ord, Show, Read, Typeable+ , FromJSON, ToJSON )++newtype MarketTypeCode = MarketTypeCode { getMarketTypeCode :: Text }+ deriving ( Eq, Ord, Show, Read, Typeable+ , FromJSON, ToJSON )++newtype MatchId = MatchId { getMatchId :: Text }+ deriving ( Eq, Ord, Show, Read, Typeable, FromJSON, ToJSON )++newtype SelectionId = SelectionId { getSelectionId :: Int }+ deriving ( Eq, Ord, Show, Read, Typeable+ , FromJSON, ToJSON )++newtype Venue = Venue { getVenue :: Text }+ deriving ( Eq, Ord, Show, Read, Typeable+ , FromJSON, ToJSON )++data CancelExecutionReport = CancelExecutionReportC+ { ceCustomerRef :: Maybe Text+ , ceStatus :: ExecutionReportStatus+ , ceErrorCode :: Maybe ExecutionReportErrorCode+ , ceMarketId :: Maybe MarketId+ , ceInstructionReports :: [CancelInstructionReport] }+ deriving ( Eq, Ord, Show, Read, Typeable )++data CancelInstruction = CancelInstructionC+ { ciBetId :: BetId+ , ciSizeReduction :: Maybe Double }+ deriving ( Eq, Ord, Show, Read, Typeable )++data CancelInstructionReport = CancelInstructionReportC+ { ciStatus :: InstructionReportStatus+ , ciInstructionReportErrorCode :: Maybe InstructionReportErrorCode+ , ciInstruction :: Maybe CancelInstruction+ , ciSizeCancelled :: Double+ , ciCancelledDate :: Maybe UTCTime }+ deriving ( Eq, Ord, Show, Read, Typeable )++data CancelOrders = CancelOrdersC+ { caMarketId :: Maybe MarketId+ , caInstructions :: Maybe [CancelInstruction]+ , caCustomerRef :: Maybe Text }+ deriving ( Eq, Ord, Show, Read, Typeable )++data ClearedOrderSummary = ClearedOrderSummaryC+ { coEventTypeId :: EventTypeId+ , coEventId :: EventId+ , coMarketId :: MarketId+ , coSelectionId :: SelectionId+ , coHandicap :: Double+ , coBetId :: BetId+ , coPlacedDate :: UTCTime+ , coPersistenceType :: Maybe PersistenceType+ , coOrderType :: Maybe OrderType+ , coSide :: Maybe Side+ , coItemDescription :: Maybe ItemDescription+ , coPriceRequested :: Maybe Double+ , coSettledDate :: Maybe UTCTime+ , coBetCount :: Int+ , coCommission :: Maybe Double+ , coPriceMatched :: Maybe Double+ , coPriceReduced :: Maybe Bool+ , coSizeSettled :: Maybe Double+ , coProfit :: Double+ , coSizeCancelled :: Maybe Double }+ deriving ( Eq, Ord, Show, Read, Typeable )++data Competition = CompetitionC+ { cId :: CompetitionId+ , cName :: Text }+ deriving ( Eq, Ord, Show, Read, Typeable )++data CompetitionResult = CompetitionResultC+ { cCompetition :: Competition+ , cMarketCount :: Int+ , cCompetitionRegion :: Text }+ deriving ( Eq, Ord, Show, Read, Typeable )++data CountryCodeResult = CountryCodeResultC+ { ccCountryCode :: Text+ , ccMarketCount :: Int }+ deriving ( Eq, Ord, Show, Read, Typeable )++data ClearedOrderSummaryReport = ClearedOrderSummaryReportC+ { coClearedOrders :: [ClearedOrderSummary]+ , coMoreAvailable :: Bool }+ deriving ( Eq, Ord, Show, Read, Typeable )++data CurrentOrderSummary = CurrentOrderSummaryC+ { cBetId :: BetId+ , cMarketId :: MarketId+ , cSelectionId :: SelectionId+ , cHandicap :: Double+ , cPriceSize :: PriceSize+ , cBspLiability :: Double+ , cSide :: Side+ , cStatus :: OrderStatus+ , cPersistenceType :: PersistenceType+ , cOrderType :: OrderType+ , cPlacedDate :: UTCTime+ , cMatchedDate :: Maybe UTCTime+ , cAveragePriceMatched :: Maybe Double+ , cSizeMatched :: Maybe Double+ , cSizeRemaining :: Maybe Double+ , cSizeLapsed :: Maybe Double+ , cSizeCancelled :: Maybe Double+ , cSizeVoided :: Maybe Double+ , cRegulatorAuthCode :: Maybe Text+ , cRegulatorCode :: Maybe Text }+ deriving ( Eq, Ord, Show, Read, Typeable )++data CurrentOrderSummaryReport = CurrentOrderSummaryReportC+ { cCurrentOrders :: [CurrentOrderSummary]+ , cMoreAvailable :: Bool }+ deriving ( Eq, Ord, Show, Read, Typeable )++data ExBestOffersOverrides = ExBestOffersOverridesC+ { ebbestPricesDepth :: Maybe Int+ , ebRollupModel :: Maybe RollupModel+ , ebRollupLimit :: Maybe Int+ , ebRollupLiabilityThreshold :: Maybe Double+ , ebRollupLiabilityFactor :: Maybe Int }+ deriving ( Eq, Ord, Show, Read, Typeable )++data ExchangePrices = ExchangePricesC+ { epAvailableToBack :: Maybe [PriceSize]+ , epAvailableToLay :: Maybe [PriceSize]+ , epTradedVolume :: Maybe [PriceSize] }+ deriving ( Eq, Ord, Show, Read, Typeable )++data Event = EventC+ { eId :: EventId+ , eName :: Text+ , eCountryCode :: Maybe Country+ , eTimezone :: Text+ , eVenue :: Maybe Text+ , eOpenDate :: UTCTime }+ deriving ( Eq, Ord, Show, Read, Typeable )++data EventResult = EventResultC+ { erEvent :: Event+ , erMarketCount :: Int }+ deriving ( Eq, Ord, Show, Read, Typeable )++data EventType = EventTypeC+ { etId :: EventTypeId+ , etName :: Text }+ deriving ( Eq, Ord, Show, Read, Typeable )++data EventTypeResult = EventTypeResultC+ { etrEventType :: EventType+ , etrMarketCount :: Int }+ deriving ( Eq, Ord, Show, Read, Typeable )++newtype Heartbeat = HeartbeatC+ { hPreferredTimeoutSeconds :: Int }+ deriving ( Eq, Ord, Show, Read, Typeable )++data HeartbeatReport = HeartbeatReportC+ { hActionPerformed :: ActionPerformed+ , hActualTimeoutSeconds :: Int }+ deriving ( Eq, Ord, Show, Read, Typeable )++data ItemDescription = ItemDescriptionC+ { iEventTypeDesc :: Maybe Text+ , iEventDesc :: Maybe Text+ , iMarketDesc :: Maybe Text+ , iMarketStartTime :: Maybe UTCTime+ , iRunnerDesc :: Maybe Text+ , iNumberOfWinners :: Maybe Int }+ deriving ( Eq, Ord, Show, Read, Typeable )++data LimitOnCloseOrder = LimitOnCloseOrderC+ { loLiability :: Double+ , loPrice :: Double }+ deriving ( Eq, Ord, Show, Read, Typeable )++data LimitOrder = LimitOrderC+ { lSize :: Double+ , lPrice :: Double+ , lPersistenceType :: PersistenceType }+ deriving ( Eq, Ord, Show, Read, Typeable )++data ListCompetitions = ListCompetitionsC+ { lcFilter :: MarketFilter+ , lcLocale :: Maybe Text }+ deriving ( Eq, Ord, Show, Read, Typeable )++data ListCountries = ListCountriesC+ { lcsFilter :: MarketFilter+ , lcsLocale :: Maybe Text }+ deriving ( Eq, Ord, Show, Read, Typeable )++data ListCurrentOrders = ListCurrentOrdersC+ { lcoBetIds :: Maybe (S.Set BetId)+ , lcoMarketIds :: Maybe (S.Set MarketId)+ , lcoOrderProjection :: Maybe OrderProjection+ , lcoDateRange :: Maybe TimeRange+ , lcoOrderBy :: Maybe OrderBy+ , lcoSortDir :: Maybe SortDir+ , lcoFromRecord :: Maybe Int+ , lcoRecordCount :: Maybe Int }+ deriving ( Eq, Ord, Show, Read, Typeable )++data ListClearedOrders = ListClearedOrdersC+ { lcrBetStatus :: BetStatus+ , lcrEventTypeIds :: Maybe (S.Set EventTypeId)+ , lcrEventIds :: Maybe (S.Set EventId)+ , lcrMarketIds :: Maybe (S.Set MarketId)+ , lcrRunnerIds :: Maybe (S.Set RunnerId)+ , lcrBetIds :: Maybe (S.Set BetId)+ , lcrSide :: Maybe Side+ , lcrSettledDateRange :: Maybe TimeRange+ , lcrGroupBy :: Maybe GroupBy+ , lcrIncludeItemDescription :: Maybe Bool+ , lcrLocale :: Maybe Text+ , lcrFromRecord :: Maybe Int+ , lcrRecordCount :: Maybe Int }+ deriving ( Eq, Ord, Show, Read, Typeable )++data ListEvents = ListEventsC+ { leFilter :: MarketFilter+ , leLocale :: Maybe Text }+ deriving ( Eq, Ord, Show, Read, Typeable )++data ListEventTypes = ListEventTypesC+ { letFilter :: MarketFilter+ , letLocale :: Maybe Text }+ deriving ( Eq, Ord, Show, Read, Typeable )++data ListMarketBook = ListMarketBookC+ { lmbMarketIds :: [MarketId]+ , lmbPriceProjection :: Maybe PriceProjection+ , lmbOrderProjection :: Maybe OrderProjection+ , lmbMatchProjection :: Maybe MatchProjection+ , lmbCurrencyCode :: Maybe Text+ , lmbLocale :: Maybe Text }+ deriving ( Eq, Ord, Show, Read, Typeable )++data ListMarketCatalogue = ListMarketCatalogueC+ { lmcFilter :: MarketFilter+ , lmcMarketProjection :: Maybe (S.Set MarketProjection)+ , lmcSort :: Maybe (S.Set MarketSort)+ , lmcMaxResults :: Int+ , lmcLocale :: Maybe Text }+ deriving ( Eq, Ord, Show, Read, Typeable )++data ListMarketProfitAndLoss = ListMarketProfitAndLossC+ { lmMarketIds :: S.Set MarketId+ , lmIncludeSettledBets :: Maybe Bool+ , lmIncludeBspBets :: Maybe Bool+ , lmNetOfCommission :: Maybe Bool }+ deriving ( Eq, Ord, Show, Read, Typeable )++data ListMarketTypes = ListMarketTypesC+ { lmtFilter :: MarketFilter+ , lmtLocale :: Maybe Text }+ deriving ( Eq, Ord, Show, Read, Typeable )++data ListTimeRanges = ListTimeRangesC+ { ltFilter :: MarketFilter+ , ltGranularity :: TimeGranularity }+ deriving ( Eq, Ord, Show, Read, Typeable )++data ListVenues = ListVenuesC+ { lvFilter :: MarketFilter+ , lvLocale :: Maybe Text }+ deriving ( Eq, Ord, Show, Read, Typeable )++data MarketBook = MarketBookC+ { mbMarketId :: MarketId+ , mbIsMarketDataDelayed :: Bool+ , mbStatus :: Maybe MarketStatus+ , mbBetDelay :: Maybe Int+ , mbBspReconciled :: Maybe Bool+ , mbComplete :: Maybe Bool+ , mbInplay :: Maybe Bool+ , mbNumberOfWinners :: Maybe Int+ , mbNumberOfRunners :: Maybe Int+ , mbNumberOfActiveRunners :: Maybe Int+ , mbLastMatchTime :: Maybe UTCTime+ , mbTotalMatched :: Maybe Double+ , mbTotalAvailable :: Maybe Double+ , mbCrossMatching :: Maybe Bool+ , mbRunnersVoidable :: Maybe Bool+ , mbVersion :: Maybe Int+ , mbRunners :: [Runner] }+ deriving ( Eq, Ord, Show, Read, Typeable )++data MarketCatalogue = MarketCatalogueC+ { mcMarketId :: MarketId+ , mcMarketName :: Text+ , mcMarketStartTime :: Maybe UTCTime+ , mcDescription :: Maybe MarketDescription+ , mcTotalMatched :: Maybe Double+ , mcRunners :: Maybe [RunnerCatalog]+ , mcEventType :: Maybe EventType+ , mcCompetition :: Maybe Competition+ , mcEvent :: Maybe Event }+ deriving ( Eq, Ord, Show, Read, Typeable )++data MarketDescription = MarketDescriptionC+ { mdPersistenceEnabled :: Bool+ , mdBspMarket :: Bool+ , mdMarketTime :: UTCTime+ , mdSuspendTime :: UTCTime+ , mdSettleTime :: Maybe UTCTime+ , mdBettingType :: MarketBettingType+ , mdTurnInPlayEnabled :: Bool+ , mdMarketType :: Text+ , mdRegulator :: Text+ , mdMarketBaseRate :: Double+ , mdDiscountAllowed :: Bool+ , mdWallet :: Maybe Text+ , mdRules :: Maybe Text+ , mdRulesHasDate :: Maybe Bool+ , mdClarifications :: Maybe Text }+ deriving ( Eq, Ord, Show, Read, Typeable )++data MarketFilter = MarketFilterC+ { mfTextQuery :: Maybe String+ , mfEventTypeIds :: Maybe (S.Set EventTypeId)+ , mfEventIds :: Maybe (S.Set EventId)+ , mfCompetitionIds :: Maybe (S.Set CompetitionId)+ , mfMarketIds :: Maybe (S.Set MarketId)+ , mfVenues :: Maybe (S.Set Venue)+ , mfBspOnly :: Maybe Bool+ , mfTurnInPlayEnabled :: Maybe Bool+ , mfInPlayOnly :: Maybe Bool+ , mfMarketBettingTypes :: Maybe (S.Set MarketBettingType)+ , mfMarketCountries :: Maybe (S.Set Country)+ , mfMarketTypeCodes :: Maybe (S.Set MarketTypeCode)+ , mfMarketStartTime :: Maybe (UTCTime, UTCTime)+ , mfWithOrders :: Maybe (S.Set OrderStatus) }+ deriving ( Eq, Ord, Show, Read, Typeable )++newtype MarketOnCloseOrder = MarketOnCloseOrderC+ { mLiability :: Double }+ deriving ( Eq, Ord, Show, Read, Typeable )++data MarketProfitAndLoss = MarketProfitAndLossC+ { mpMarketId :: Maybe MarketId+ , mpCommissionApplied :: Maybe Double+ , mpProfitAndLosses :: Maybe [RunnerProfitAndLoss] }+ deriving ( Eq, Ord, Show, Read, Typeable )++data MarketTypeResult = MarketTypeResultC+ { mtMarketType :: Text+ , mtMarketCount :: Int }+ deriving ( Eq, Ord, Show, Read, Typeable )++data Match = MatchC+ { mBetId :: Maybe BetId+ , mMatchId :: Maybe MatchId+ , mSide :: Side+ , mPrice :: Double+ , mSize :: Double+ , mMatchDate :: Maybe UTCTime }+ deriving ( Eq, Ord, Show, Read, Typeable )++data Order = OrderC+ { oBetId :: BetId+ , oOrderType :: OrderType+ , oStatus :: OrderStatus+ , oPersistenceType :: Maybe PersistenceType+ , oSide :: Side+ , oPrice :: Double+ , oSize :: Double+ , oBspLiability :: Double+ , oPlacedDate :: UTCTime+ , oAvgPriceMatched :: Maybe Double+ , oSizeMatched :: Maybe Double+ , oSizeRemaining :: Maybe Double+ , oSizeLapsed :: Maybe Double+ , oSizeCancelled :: Maybe Double+ , oSizeVoided :: Maybe Double }+ deriving ( Eq, Ord, Show, Read, Typeable )++data PlaceExecutionReport = PlaceExecutionReportC+ { peCustomerRef :: Maybe Text+ , peStatus :: ExecutionReportStatus+ , peErrorCode :: Maybe ExecutionReportErrorCode+ , peMarketId :: Maybe MarketId+ , peInstructionReports :: Maybe [PlaceInstructionReport] }+ deriving ( Eq, Ord, Show, Read, Typeable )++data PlaceInstruction = PlaceInstructionC+ { pOrderType :: OrderType+ , pSelectionId :: SelectionId+ , pHandicap :: Maybe Double+ , pSide :: Side+ , pLimitOrder :: Maybe LimitOrder+ , pLimitOnCloseOrder :: Maybe LimitOnCloseOrder+ , pMarketOnCloseOrder :: Maybe MarketOnCloseOrder }+ deriving ( Eq, Ord, Show, Read, Typeable )++data PlaceInstructionReport = PlaceInstructionReportC+ { piStatus :: InstructionReportStatus+ , piErrorCode :: Maybe InstructionReportErrorCode+ , piInstruction :: PlaceInstruction+ , piBetId :: Maybe Text+ , piPlacedDate :: Maybe UTCTime+ , piAveragePriceMatched :: Maybe Double+ , piSizeMatched :: Maybe Double }+ deriving ( Eq, Ord, Show, Read, Typeable )++data PlaceOrders = PlaceOrdersC+ { pMarketId :: MarketId+ , pInstructions :: [PlaceInstruction]+ , pCustomerRef :: Maybe Text }+ deriving ( Eq, Ord, Show, Read, Typeable )++data PriceProjection = PriceProjectionC+ { ppPriceData :: Maybe (S.Set PriceData)+ , ppExBestOffersOverrides :: Maybe ExBestOffersOverrides+ , ppVirtualize :: Maybe Bool+ , ppRolloverStakes :: Maybe Bool }+ deriving ( Eq, Ord, Show, Read, Typeable )++data PriceSize = PriceSizeC+ { psPrice :: Double+ , psSize :: Double }+ deriving ( Eq, Ord, Show, Read, Typeable )++data ReplaceExecutionReport = ReplaceExecutionReportC+ { reCustomerRef :: Maybe Text+ , reStatus :: ExecutionReportStatus+ , reErrorCode :: Maybe ExecutionReportErrorCode+ , reMarketId :: Maybe Text+ , reInstructionReports :: Maybe [ReplaceInstructionReport] }+ deriving ( Eq, Ord, Show, Read, Typeable )++data ReplaceInstruction = ReplaceInstructionC+ { rBetId :: BetId+ , rNewPrice :: Double }+ deriving ( Eq, Ord, Show, Read, Typeable )++data ReplaceInstructionReport = ReplaceInstructionReportC+ { riStatus :: InstructionReportStatus+ , riErrorCode :: Maybe InstructionReportErrorCode+ , riCancelInstructionReport :: Maybe CancelInstructionReport+ , riPlaceInstructionReport :: Maybe PlaceInstructionReport }+ deriving ( Eq, Ord, Show, Read, Typeable )++data ReplaceOrders = ReplaceOrdersC+ { rMarketId :: MarketId+ , rInstructions :: [ReplaceInstruction]+ , rCustomerRef :: Maybe Text }+ deriving ( Eq, Ord, Show, Read, Typeable )++data Runner = RunnerC+ { rSelectionId :: SelectionId+ , rHandicap :: Double+ , rStatus :: RunnerStatus+ , rAdjustmentFactor :: Maybe Double -- the official documentation says+ -- this is required but it's lying.+ -- lying! so we use Maybe+ , rLastPriceTraded :: Maybe Double+ , rTotalMatched :: Maybe Double+ , rRemovalData :: Maybe UTCTime+ , rSp :: Maybe StartingPrices+ , rEx :: Maybe ExchangePrices+ , rOrders :: Maybe [Order]+ , rMatches :: Maybe [Match] }+ deriving ( Eq, Ord, Show, Read, Typeable )++data RunnerCatalog = RunnerCatalogC+ { rcSelectionId :: SelectionId+ , rcRunnerName :: Text+ , rcHandicap :: Double+ , rcSortPriority :: Int+ , rcMetadata :: M.Map Text Text }+ deriving ( Eq, Ord, Show, Read, Typeable )++data RunnerId = RunnerIdC+ { riMarketId :: MarketId+ , riSelectionId :: SelectionId+ , riHandicap :: Maybe Double }+ deriving ( Eq, Ord, Show, Read, Typeable )++data RunnerProfitAndLoss = RunnerProfitAndLossC+ { rpSelectionId :: Maybe SelectionId+ , rpIfWin :: Maybe Double+ , rpIfLose :: Maybe Double }+ deriving ( Eq, Ord, Show, Read, Typeable )++data StartingPrices = StartingPricesC+ { spNearPrice :: Maybe Double+ , spFarPrice :: Maybe Double+ , spBackStakeTaken :: Maybe [PriceSize]+ , spLayLiabilityTaken :: Maybe [PriceSize]+ , spActualSP :: Maybe Double }+ deriving ( Eq, Ord, Show, Read, Typeable )++data TimeRange = TimeRangeC+ { tFrom :: UTCTime+ , tTo :: UTCTime }+ deriving ( Eq, Ord, Show, Read, Typeable )++data TimeRangeResult = TimeRangeResultC+ { tTimeRange :: TimeRange+ , tMarketCount :: Int }+ deriving ( Eq, Ord, Show, Read, Typeable )++data UpdateExecutionReport = UpdateExecutionReportC+ { ueCustomerRef :: Maybe Text+ , ueStatus :: ExecutionReportStatus+ , ueErrorCode :: Maybe ExecutionReportErrorCode+ , ueMarketId :: Maybe Text+ , ueInstructionReports :: Maybe [UpdateInstructionReport] }+ deriving ( Eq, Ord, Show, Read, Typeable )++data UpdateInstruction = UpdateInstructionC+ { uBetId :: BetId+ , uNewPersistenceType :: PersistenceType }+ deriving ( Eq, Ord, Show, Read, Typeable )++data UpdateInstructionReport = UpdateInstructionReportC+ { uiStatus :: InstructionReportStatus+ , uiErrorCode :: Maybe InstructionReportErrorCode+ , uiInstruction :: UpdateInstruction }+ deriving ( Eq, Ord, Show, Read, Typeable )++data UpdateOrders = UpdateOrdersC+ { uMarketId :: MarketId+ , uInstructions :: [UpdateInstruction]+ , uCustomerRef :: Maybe Text }+ deriving ( Eq, Ord, Show, Read, Typeable )++data VenueResult = VenueResultC+ { vVenue :: Text+ , vMarketCount :: Int }+ deriving ( Eq, Ord, Show, Read, Typeable )++data APIException = APIException { exceptionDetails :: Text+ , exceptionCode :: APIExceptionCode }+ deriving ( Eq, Ord, Show, Read, Typeable )++instance Exception APIException++-- | Pattern synonym that just matches on the `APIExceptionCode` part of+-- `APIException`.+pattern APIExcCode b <- APIException _ b++data APIExceptionCode+ = TooMuchData+ | InvalidInputData+ | InvalidSessionInformation+ | NoAppKey+ | NoSession+ | UnexpectedError+ | InvalidAppKey+ | TooManyRequests+ | ServiceBusy+ | TimeoutError+ | RequestSizeExceedsLimit+ | AccessDenied+ deriving ( Eq, Ord, Show, Read, Typeable, Enum )++makeLensesWith abbreviatedFields ''CancelExecutionReport+makeLensesWith abbreviatedFields ''CancelInstruction+makeLensesWith abbreviatedFields ''CancelInstructionReport+makeLensesWith abbreviatedFields ''CancelOrders+makeLensesWith abbreviatedFields ''ClearedOrderSummary+makeLensesWith abbreviatedFields ''ClearedOrderSummaryReport+makeLensesWith abbreviatedFields ''Competition+makeLensesWith abbreviatedFields ''CompetitionResult+makeLensesWith abbreviatedFields ''CountryCodeResult+makeLensesWith abbreviatedFields ''CurrentOrderSummary+makeLensesWith abbreviatedFields ''CurrentOrderSummaryReport+makeLensesWith abbreviatedFields ''ExBestOffersOverrides+makeLensesWith abbreviatedFields ''ExchangePrices+makeLensesWith abbreviatedFields ''Event+makeLensesWith abbreviatedFields ''EventResult+makeLensesWith abbreviatedFields ''EventType+makeLensesWith abbreviatedFields ''EventTypeResult+makeLensesWith abbreviatedFields ''ItemDescription+makeLensesWith abbreviatedFields ''LimitOnCloseOrder+makeLensesWith abbreviatedFields ''LimitOrder+makeLensesWith abbreviatedFields ''ListCompetitions+makeLensesWith abbreviatedFields ''ListCountries+makeLensesWith abbreviatedFields ''ListCurrentOrders+makeLensesWith abbreviatedFields ''ListClearedOrders+makeLensesWith abbreviatedFields ''ListEvents+makeLensesWith abbreviatedFields ''ListEventTypes+makeLensesWith abbreviatedFields ''ListMarketBook+makeLensesWith abbreviatedFields ''ListMarketCatalogue+makeLensesWith abbreviatedFields ''ListMarketProfitAndLoss+makeLensesWith abbreviatedFields ''ListMarketTypes+makeLensesWith abbreviatedFields ''ListTimeRanges+makeLensesWith abbreviatedFields ''ListVenues+makeLensesWith abbreviatedFields ''MarketBook+makeLensesWith abbreviatedFields ''MarketCatalogue+makeLensesWith abbreviatedFields ''MarketDescription+makeLensesWith abbreviatedFields ''MarketFilter+makeLensesWith abbreviatedFields ''MarketOnCloseOrder+makeLensesWith abbreviatedFields ''MarketProfitAndLoss+makeLensesWith abbreviatedFields ''MarketTypeResult+makeLensesWith abbreviatedFields ''Match+makeLensesWith abbreviatedFields ''Order+makeLensesWith abbreviatedFields ''PlaceExecutionReport+makeLensesWith abbreviatedFields ''PlaceInstruction+makeLensesWith abbreviatedFields ''PlaceInstructionReport+makeLensesWith abbreviatedFields ''PlaceOrders+makeLensesWith abbreviatedFields ''PriceProjection+makeLensesWith abbreviatedFields ''PriceSize+makeLensesWith abbreviatedFields ''ReplaceExecutionReport+makeLensesWith abbreviatedFields ''ReplaceInstruction+makeLensesWith abbreviatedFields ''ReplaceInstructionReport+makeLensesWith abbreviatedFields ''ReplaceOrders+makeLensesWith abbreviatedFields ''Runner+makeLensesWith abbreviatedFields ''RunnerCatalog+makeLensesWith abbreviatedFields ''RunnerId+makeLensesWith abbreviatedFields ''RunnerProfitAndLoss+makeLensesWith abbreviatedFields ''StartingPrices+makeLensesWith abbreviatedFields ''TimeRange+makeLensesWith abbreviatedFields ''TimeRangeResult+makeLensesWith abbreviatedFields ''UpdateExecutionReport+makeLensesWith abbreviatedFields ''UpdateInstruction+makeLensesWith abbreviatedFields ''UpdateInstructionReport+makeLensesWith abbreviatedFields ''UpdateOrders+makeLensesWith abbreviatedFields ''VenueResult++-- the number is how many characters to drop from a record field name to get+-- the JSON name in the API+deriveJSON commonStruct ''CancelExecutionReport+deriveJSON commonStruct ''CancelInstruction+deriveJSON commonStruct ''CancelInstructionReport+deriveJSON commonStruct ''CancelOrders+deriveJSON commonStruct ''ClearedOrderSummary+deriveJSON commonStruct ''ClearedOrderSummaryReport+deriveJSON commonStruct ''Competition+deriveJSON commonStruct ''CompetitionResult+deriveJSON commonStruct ''CountryCodeResult+deriveJSON commonStruct ''CurrentOrderSummary+deriveJSON commonStruct ''CurrentOrderSummaryReport+deriveJSON commonStruct ''ExBestOffersOverrides+deriveJSON commonStruct ''ExchangePrices+deriveJSON commonStruct ''Event+deriveJSON commonStruct ''EventResult+deriveJSON commonStruct ''EventType+deriveJSON commonStruct ''EventTypeResult+deriveJSON commonStruct ''Heartbeat+deriveJSON commonStruct ''HeartbeatReport+deriveJSON commonStruct ''ItemDescription+deriveJSON commonStruct ''LimitOnCloseOrder+deriveJSON commonStruct ''LimitOrder+deriveJSON commonStruct ''ListCompetitions+deriveJSON commonStruct ''ListCountries+deriveJSON commonStruct ''ListCurrentOrders+deriveJSON commonStruct ''ListClearedOrders+deriveJSON commonStruct ''ListEvents+deriveJSON commonStruct ''ListEventTypes+deriveJSON commonStruct ''ListMarketBook+deriveJSON commonStruct ''ListMarketCatalogue+deriveJSON commonStruct ''ListMarketProfitAndLoss+deriveJSON commonStruct ''ListMarketTypes+deriveJSON commonStruct ''ListTimeRanges+deriveJSON commonStruct ''ListVenues+deriveJSON commonStruct ''MarketBook+deriveJSON commonStruct ''MarketCatalogue+deriveJSON commonStruct ''MarketDescription+deriveJSON commonStruct ''MarketFilter+deriveJSON commonStruct ''MarketOnCloseOrder+deriveJSON commonStruct ''MarketProfitAndLoss+deriveJSON commonStruct ''MarketTypeResult+deriveJSON commonStruct ''Match+deriveJSON commonStruct ''Order+deriveJSON commonStruct ''PlaceExecutionReport+deriveJSON commonStruct ''PlaceInstruction+deriveJSON commonStruct ''PlaceInstructionReport+deriveJSON commonStruct ''PlaceOrders+deriveJSON commonStruct ''PriceProjection+deriveJSON commonStruct ''PriceSize+deriveJSON commonStruct ''ReplaceExecutionReport+deriveJSON commonStruct ''ReplaceInstruction+deriveJSON commonStruct ''ReplaceInstructionReport+deriveJSON commonStruct ''ReplaceOrders+deriveJSON commonStruct ''Runner+deriveJSON commonStruct ''RunnerCatalog+deriveJSON commonStruct ''RunnerId+deriveJSON commonStruct ''RunnerProfitAndLoss+deriveJSON commonStruct ''StartingPrices+deriveJSON commonStruct ''TimeRange+deriveJSON commonStruct ''TimeRangeResult+deriveJSON commonStruct ''UpdateExecutionReport+deriveJSON commonStruct ''UpdateInstruction+deriveJSON commonStruct ''UpdateInstructionReport+deriveJSON commonStruct ''UpdateOrders+deriveJSON commonStruct ''VenueResult++deriveJSON (commonEnum 1) ''ActionPerformed+deriveJSON (commonEnum 0) ''BetStatus+deriveJSON (commonEnum 1) ''ExecutionReportErrorCode+deriveJSON (commonEnum 1) ''ExecutionReportStatus+deriveJSON (commonEnum 2) ''GroupBy+deriveJSON (commonEnum 0) ''InstructionReportErrorCode+deriveJSON (commonEnum 0) ''InstructionReportStatus+deriveJSON (commonEnum 0) ''MarketBettingType+deriveJSON (commonEnum 0) ''MarketProjection+deriveJSON (commonEnum 0) ''MarketSort+deriveJSON (commonEnum 0) ''MarketStatus+deriveJSON (commonEnum 0) ''MatchProjection+deriveJSON (commonEnum 0) ''OrderBy+deriveJSON (commonEnum 2) ''OrderProjection+deriveJSON (commonEnum 0) ''OrderStatus+deriveJSON (commonEnum 0) ''OrderType+deriveJSON (commonEnum 2) ''PersistenceType+deriveJSON (commonEnum 0) ''PriceData+deriveJSON (commonEnum 0) ''RollupModel+deriveJSON (commonEnum 0) ''RunnerStatus+deriveJSON (commonEnum 0) ''SortDir+deriveJSON (commonEnum 0) ''TimeGranularity++deriveJSON (commonEnum 0) ''APIExceptionCode++instance Request CancelOrders [CancelExecutionReport] where+ requestMethod _ = "SportsAPING/v1.0/cancelOrders"+ requestUrl _ = bettingUrl++instance Request ListCompetitions [CompetitionResult] where+ requestMethod _ = "SportsAPING/v1.0/listCompetitions"+ requestUrl _ = bettingUrl++instance Request ListCountries [CountryCodeResult] where+ requestMethod _ = "SportsAPING/v1.0/listCountries"+ requestUrl _ = bettingUrl++instance Request ListCurrentOrders CurrentOrderSummaryReport where+ requestMethod _ = "SportsAPING/v1.0/listCurrentOrders"+ requestUrl _ = bettingUrl++instance Request ListClearedOrders ClearedOrderSummaryReport where+ requestMethod _ = "SportsAPING/v1.0/listClearedOrders"+ requestUrl _ = bettingUrl++instance Request ListEvents [EventResult] where+ requestMethod _ = "SportsAPING/v1.0/listEvents"+ requestUrl _ = bettingUrl++instance Request ListEventTypes [EventTypeResult] where+ requestMethod _ = "SportsAPING/v1.0/listEventTypes"+ requestUrl _ = bettingUrl++instance Request ListMarketBook [MarketBook] where+ requestMethod _ = "SportsAPING/v1.0/listMarketBook"+ requestUrl _ = bettingUrl++instance Request ListMarketCatalogue [MarketCatalogue] where+ requestMethod _ = "SportsAPING/v1.0/listMarketCatalogue"+ requestUrl _ = bettingUrl++instance Request ListMarketProfitAndLoss [MarketProfitAndLoss] where+ requestMethod _ = "SportsAPING/v1.0/listMarketProfitAndLoss"+ requestUrl _ = bettingUrl++instance Request ListMarketTypes [MarketTypeResult] where+ requestMethod _ = "SportsAPING/v1.0/listMarketTypes"+ requestUrl _ = bettingUrl++instance Request ListTimeRanges [TimeRangeResult] where+ requestMethod _ = "SportsAPING/v1.0/listTimeRanges"+ requestUrl _ = bettingUrl++instance Request ListVenues [VenueResult] where+ requestMethod _ = "SportsAPING/v1.0/listVenues"+ requestUrl _ = bettingUrl++instance Request PlaceOrders PlaceExecutionReport where+ requestMethod _ = "SportsAPING/v1.0/placeOrders"+ requestUrl _ = bettingUrl++instance Request ReplaceOrders ReplaceExecutionReport where+ requestMethod _ = "SportsAPING/v1.0/replaceOrders"+ requestUrl _ = bettingUrl++instance Request UpdateOrders UpdateExecutionReport where+ requestMethod _ = "SportsAPING/v1.0/updateOrders"+ requestUrl _ = bettingUrl++instance Request Heartbeat HeartbeatReport where+ requestMethod _ = "HeartbeatAPING/v1.0/heartbeat"+ requestUrl _ = heartbeatUrl++-- | Data types in Betfair API that have some kind of default.+--+-- All `Maybe` fields in records are set to `Nothing`, all lists and sets will+-- be empty. If there is no sensible default then the type won't implement this+-- typeclass.+class Default a where+ def :: a++instance Default CancelOrders where+ def = CancelOrdersC Nothing Nothing Nothing++instance Default ExBestOffersOverrides where+ def = ExBestOffersOverridesC Nothing Nothing Nothing Nothing Nothing++instance Default ExchangePrices where+ def = ExchangePricesC Nothing Nothing Nothing++instance Default ListCompetitions where+ def = ListCompetitionsC+ { lcFilter = def+ , lcLocale = Nothing }++instance Default ListCountries where+ def = ListCountriesC+ { lcsFilter = def+ , lcsLocale = Nothing }++instance Default ListCurrentOrders where+ def = ListCurrentOrdersC Nothing Nothing Nothing Nothing Nothing Nothing+ Nothing Nothing++-- | `lcrBetStatus` is `Settled`.+instance Default ListClearedOrders where+ def = ListClearedOrdersC Settled Nothing Nothing Nothing Nothing Nothing+ Nothing Nothing Nothing Nothing Nothing Nothing+ Nothing++instance Default ListEvents where+ def = ListEventsC+ { leFilter = def+ , leLocale = Nothing }++instance Default ListEventTypes where+ def = ListEventTypesC+ { letFilter = def+ , letLocale = Nothing }++instance Default ListMarketBook where+ def = ListMarketBookC+ { lmbMarketIds = []+ , lmbPriceProjection = Nothing+ , lmbOrderProjection = Nothing+ , lmbMatchProjection = Nothing+ , lmbCurrencyCode = Nothing+ , lmbLocale = Nothing }++-- | `lmcMaxResults` is set to 1000.+instance Default ListMarketCatalogue where+ def = ListMarketCatalogueC+ { lmcFilter = def+ , lmcMarketProjection = Nothing+ , lmcSort = Nothing+ , lmcMaxResults = 1000+ , lmcLocale = Nothing }++instance Default ListMarketProfitAndLoss where+ def = ListMarketProfitAndLossC S.empty Nothing Nothing Nothing++instance Default ListMarketTypes where+ def = ListMarketTypesC+ { lmtFilter = def+ , lmtLocale = Nothing }++-- | `TimeGranularity` is set to `Days`.+instance Default ListTimeRanges where+ def = ListTimeRangesC+ { ltFilter = def+ , ltGranularity = Days }++instance Default ListVenues where+ def = ListVenuesC+ { lvFilter = def+ , lvLocale = Nothing }++instance Default MarketFilter where+ def = MarketFilterC Nothing Nothing Nothing Nothing Nothing Nothing Nothing+ Nothing Nothing Nothing Nothing Nothing Nothing Nothing++instance Default PriceProjection where+ def = PriceProjectionC Nothing Nothing Nothing Nothing+++-- | Things that have a non-ambiguous way to extract a `Bet` from them.+--+-- Note that terminology does not match up correctly, `Bet` is about+-- odds-markets but some bets don't work with odds. However with this+-- construction, price is matched to odds and size is matched to stake.+class HasBet a where+ bet :: Lens' a (Bet Double Double)++instance HasBet CurrentOrderSummary where+ bet = lens (\cosum -> Bet (cSide cosum)+ (psPrice $ cPriceSize cosum)+ (psSize $ cPriceSize cosum))+ (\old new -> old { cSide = new^.betType+ , cPriceSize = PriceSizeC+ { psPrice = new^.odds+ , psSize = new^.stake } })++instance HasBet Match where+ bet = lens (\m -> Bet (mSide m) (mPrice m) (mSize m))+ (\old new -> old { mSide = new^.betType+ , mPrice = new^.odds+ , mSize = new^.stake })++instance HasBet Order where+ bet = lens (\o -> Bet (oSide o) (oPrice o) (oSize o))+ (\old new -> old { oSide = new^.betType+ , oPrice = new^.odds+ , oSize = new^.stake })++
+ src/Network/Betfair/Types/TH.hs view
@@ -0,0 +1,44 @@+-- | Helper functions for template haskell that generate JSON instances for+-- Betfair API types. This is unlikely to be useful to you if you are just a+-- user of this library.+--++module Network.Betfair.Types.TH+ ( commonEnum+ , commonStruct )+ where++import Data.Aeson.TH+import Data.Char++commonStruct :: Options+commonStruct =+ defaultOptions {+ fieldLabelModifier = lowerFirst . dropPrefix+ , omitNothingFields = True+ }++underscorify :: String -> String+underscorify str = reverse $ rec str [] where+ rec [] accum = accum+ rec (x:y:rest) accum+ | isLower x && isUpper y = rec rest $ y:'_':x:accum+ rec (z:rest) accum = rec rest (z:accum)++dropPrefix :: String -> String+dropPrefix [] = []+dropPrefix (x:rest)+ | isUpper x = x:rest+ | otherwise = dropPrefix rest++lowerFirst :: String -> String+lowerFirst [] = []+lowerFirst (x:rest) = toLower x:rest++commonEnum :: Int -> Options+commonEnum ln =+ defaultOptions {+ constructorTagModifier = fmap toUpper . underscorify . drop ln+ , allNullaryToStringTag = True+ }+
+ src/Network/Betfair/Unsafe.hs view
@@ -0,0 +1,35 @@+-- | (Financially) unsafe Betfair API functions.+--++module Network.Betfair.Unsafe+ (+ -- * Rate limiting+ setAPIRateLimit+ , getAPIRateLimit+ , NumberOfRequests )+ where++import Data.IORef+import Network.Betfair.Internal++-- | Set the global rate limit.+--+-- The initial value is 4. The rate limiting is global and shared with all+-- Betfair connections in the same Haskell process.+--+-- DANGEROUS! If the limit allows for more than 20 requests per second then you+-- have to pay up Betfair data charge fee.+--+-- This can be a fractional value like 19.8 if you like living dangerously.+--+-- Setting this to 0 prevents all further communication with Betfair (aside+-- from logging in).+setAPIRateLimit :: NumberOfRequests -> IO ()+setAPIRateLimit nor+ | nor < 0 = error "setAPIRateLimit: limit cannot be negative."+ | otherwise = atomicModifyIORef' rateLimit $ \_ -> ( nor, () )++-- | Returns the current global rate limit.+getAPIRateLimit :: IO Double+getAPIRateLimit = readIORef rateLimit+
+ test/DataBet.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE ViewPatterns #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module DataBet+ ( dataBetTestGroup )+ where++import Control.Applicative+import Control.Lens+import Data.Bet+import Data.Semigroup+import Test.Framework.TH+import Test.Framework.Providers.QuickCheck2+import Test.QuickCheck++instance (Arbitrary odds, Arbitrary money) => Arbitrary (Bet odds money) where+ arbitrary = Bet <$> arbitrary <*> arbitrary <*> arbitrary++instance Arbitrary BetType where+ arbitrary = do+ x <- arbitrary+ return $ if x then Back else Lay++asBetD :: Bet Double Double -> Bet Double Double+asBetD = id++dataBetTestGroup = $(testGroupGenerator)++prop_bettype_pattern (asBetD -> bet) =+ case bet of+ BetType Back -> bet^.betType == Back+ BetType Lay -> bet^.betType == Lay+ _ -> error "impossible"++prop_bet_semigroup (asBetD -> bet) (asBetD -> bet2) =+ let mbet = bimap Sum Sum bet+ mbet2 = bimap Sum Sum bet2+ bet3 = bimap getSum getSum $ mbet <> mbet2+ in bet3^.stake == bet^.stake + bet2^.stake++prop_betflipped_semigroup (asBetD -> bet) (asBetD -> bet2) =+ let mbet = bimap Sum Sum $ BetFlipped bet+ mbet2 = bimap Sum Sum $ BetFlipped $ bet2+ bet3 = getFlipped $ bimap getSum getSum $ mbet <> mbet2+ in bet3^.odds == bet^.odds + bet2^.odds++prop_back_liability (asBetD -> bet) = bet^.betType == Back ==>+ bet^.liability == bet^.stake++prop_back_set_liability (asBetD -> bet) z = bet^.betType == Back ==>+ (bet & liability .~ z)^.stake == z++prop_lay_liability (asBetD -> bet) = bet^.betType == Lay ==>+ bet^.liability == bet^.stake * (bet^.odds-1)++prop_lay_set_liability (asBetD -> bet) = bet^.betType == Lay ==>+ abs ((bet & liability .~ (bet^.liability))^.stake - bet^.stake) < 0.001+
+ test/Main.hs view
@@ -0,0 +1,8 @@+module Main ( main ) where++import qualified DataBet as DB+import Test.Framework++main :: IO ()+main = defaultMain [DB.dataBetTestGroup]+
+ toys/login-test/Main.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}++module Main ( main ) where++import Control.Applicative+import Network.Betfair+import System.Environment+import System.Exit+import System.IO++main :: IO ()+main = withOpenSSL $ do+ args <- getArgs+ if null args+ then usageHelp >> exitFailure+ else performLogin $ head args++performLogin :: FilePath -> IO ()+performLogin fpath = do+ file <- openFile fpath ReadMode+ credentials <- read <$> hGetContents file+ betfair <- openBetfair credentials+ betfair `seq` putStrLn "Successfully logged in!"++usageHelp :: IO ()+usageHelp = do+ putStrLn "Usage: login-test [credentials file]\n"+ putStrLn $ "The credentials file should be a `Read`able " +++ "`Network.Betfair.Credentials` value. Here's an example:"+ putStrLn $ show $ Credentials+ { _username = "blahblah"+ , _password = "123456789"+ , _apiKey = "1bcj nice api key blarghh"+ , _certificatePrivateKeyFile = "ssl/secret.key"+ , _certificateCertificateFile = "ssl/secret.crt" }++