diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -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.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/bet.cabal b/bet.cabal
new file mode 100644
--- /dev/null
+++ b/bet.cabal
@@ -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.
+ .
+
+ .
+ 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
+
diff --git a/src/Data/Bet.hs b/src/Data/Bet.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Bet.hs
@@ -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"
+
diff --git a/src/Network/Betfair.hs b/src/Network/Betfair.hs
new file mode 100644
--- /dev/null
+++ b/src/Network/Betfair.hs
@@ -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 ().
+--
+-- You need a Betfair account, API keys and registered SSL certificates to use
+-- this module.
+--
+-- Using the API may subject you to data 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 })
+
diff --git a/src/Network/Betfair/Internal.hs b/src/Network/Betfair/Internal.hs
new file mode 100644
--- /dev/null
+++ b/src/Network/Betfair/Internal.hs
@@ -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
+
diff --git a/src/Network/Betfair/Types.hs b/src/Network/Betfair/Types.hs
new file mode 100644
--- /dev/null
+++ b/src/Network/Betfair/Types.hs
@@ -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.
+--
+--
+--
+-- 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 })
+
+
diff --git a/src/Network/Betfair/Types/TH.hs b/src/Network/Betfair/Types/TH.hs
new file mode 100644
--- /dev/null
+++ b/src/Network/Betfair/Types/TH.hs
@@ -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
+ }
+
diff --git a/src/Network/Betfair/Unsafe.hs b/src/Network/Betfair/Unsafe.hs
new file mode 100644
--- /dev/null
+++ b/src/Network/Betfair/Unsafe.hs
@@ -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
+
diff --git a/test/DataBet.hs b/test/DataBet.hs
new file mode 100644
--- /dev/null
+++ b/test/DataBet.hs
@@ -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
+
diff --git a/test/Main.hs b/test/Main.hs
new file mode 100644
--- /dev/null
+++ b/test/Main.hs
@@ -0,0 +1,8 @@
+module Main ( main ) where
+
+import qualified DataBet as DB
+import Test.Framework
+
+main :: IO ()
+main = defaultMain [DB.dataBetTestGroup]
+
diff --git a/toys/login-test/Main.hs b/toys/login-test/Main.hs
new file mode 100644
--- /dev/null
+++ b/toys/login-test/Main.hs
@@ -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" }
+
+