diff --git a/bet.cabal b/bet.cabal --- a/bet.cabal +++ b/bet.cabal @@ -1,5 +1,5 @@ name: bet -version: 0.1.2.2 +version: 0.1.2.3 synopsis: Betfair API bindings. Bet on sports on betting exchanges. description: This library contains Haskell bindings to the Betfair API. @@ -53,19 +53,19 @@ build-depends: aeson >=0.8.0.2 && <1.0 ,base >=4.7 && <5.0 ,bifunctors >=4.2 && <5.0 + ,binary >=0.7.1 && <1.0 ,bytestring >=0.10 && <1.0 ,containers >=0.5 && <1.0 ,exceptions >=0.6 && <1.0 ,HsOpenSSL >=0.11 && <1.0 + ,http-client >=0.4.16 && <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 + ,semigroupoids >=4.2 && <6.0 ,text >=1.2 && <2.0 - ,time >=1.4 && <1.5 + ,time >=1.4 && <2.0 ghc-options: -Wall hs-source-dirs: src default-language: Haskell2010 diff --git a/src/Data/Bet.hs b/src/Data/Bet.hs --- a/src/Data/Bet.hs +++ b/src/Data/Bet.hs @@ -6,6 +6,7 @@ {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE GADTs #-} @@ -46,19 +47,23 @@ import Control.Lens import Data.Aeson import Data.Bifoldable +import Data.Binary ( Binary ) import Data.Bitraversable +import Data.Data import Data.Foldable import Data.Semigroup import Data.Semigroup.Foldable import Data.Semigroup.Bifoldable import Data.Traversable -import Data.Typeable +import GHC.Generics -- | 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 ) + deriving ( Eq, Ord, Show, Read, Typeable, Enum, Data, Generic ) +instance Binary BetType + -- | An `Iso` from `BetType` to `Bool`. betBool :: Iso' BetType Bool betBool = iso (\case @@ -96,8 +101,12 @@ , Read , Show , Ord - , Eq ) + , Eq + , Data + , Generic ) +instance (Binary a, Binary b) => Binary (Bet a b) + instance Foldable1 (Bet odds) instance Bifoldable1 Bet @@ -122,7 +131,11 @@ , Read , Show , Ord - , Eq ) + , Eq + , Data + , Generic ) + +instance (Binary a, Binary b) => Binary (BetFlipped a b) instance Functor (BetFlipped money) where fmap f (getFlipped -> Bet t o m) = BetFlipped $ Bet t (f o) m diff --git a/src/Network/Betfair.hs b/src/Network/Betfair.hs --- a/src/Network/Betfair.hs +++ b/src/Network/Betfair.hs @@ -4,6 +4,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE LambdaCase #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-} @@ -80,23 +81,22 @@ import Control.Monad.Catch import Control.Monad.State.Strict import Data.Aeson -import Data.ByteString ( ByteString ) +import Data.Binary hiding ( get, put, encode, decode ) +import qualified Data.Binary as B 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.Data 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 GHC.Generics import Network.Betfair.Internal import Network.Betfair.Types +import Network.HTTP.Client hiding ( Proxy, Request ) +import qualified Network.HTTP.Client as PH 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. @@ -106,9 +106,23 @@ , _certificatePrivateKeyFile :: FilePath , _certificateCertificateFile :: FilePath , _apiKey :: Text } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) makeClassy ''Credentials +instance Binary Credentials where + put (Credentials{..}) = do + B.put (T.unpack _username) + B.put (T.unpack _password) + B.put _certificatePrivateKeyFile + B.put _certificateCertificateFile + B.put (T.unpack _apiKey) + get = Credentials <$> + (T.pack <$> B.get) <*> + (T.pack <$> B.get) <*> + B.get <*> + B.get <*> + (T.pack <$> B.get) + data Work = Work !Url !JsonRPCQuery !(MVar (Either SomeException BL.ByteString)) deriving ( Eq, Typeable ) @@ -120,6 +134,7 @@ -- The type of all JSON-based queries received newtype JsonRPC a = JsonRPC (Either APIException a) + deriving ( Eq, Show, Typeable ) data BetfairHandle = BetfairHandle { _betfairThread :: !ThreadId @@ -188,16 +203,17 @@ Nothing -> throwM BetfairIsClosed Just bhandle -> action bhandle -work :: (FromJSON a) => Betfair -> Url -> JsonRPCQuery -> IO a +work :: forall a. (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 + Right result -> case eitherDecode result of + Left err -> + throwM $ ParsingFailure $ "Betfair behaved in unexpected way. Error: " <> T.pack err <> " Received raw string: " <> (T.pack $ show result) + Right (JsonRPC (Left exc)) -> throwM exc + Right (JsonRPC (Right x)) -> return x betfairConnection :: Credentials -> MVar (Either SomeException ()) @@ -226,6 +242,22 @@ finally (restore $ workLoop session_key credentials m work_mvar) (killThread keep_alive_tid) +withResponseBody :: PH.Request -> Manager -> (B.ByteString -> IO a) -> IO a +withResponseBody request m action = + withResponse request m $ \body_reader -> do + let body = responseBody body_reader + bs <- readUpToNBytes 50000000 body + action bs + where + readUpToNBytes bytes body = recursive bytes body mempty + where + recursive 0 _ result = return result + recursive n requestor result = do + bs <- body + if B.null bs + then return result + else recursive (n - B.length bs) requestor (result <> bs) + workLoop :: SessionKey -> Credentials -> Manager -> MVar Work -> IO () workLoop session_key credentials m work_mvar = forever $ do work <- takeMVar work_mvar @@ -238,9 +270,8 @@ -- 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) + withResponseBody request m $ \body -> + putMVar result_mvar (Right $ BL.fromStrict body) betfairRequest :: SessionKey -> Credentials @@ -263,12 +294,11 @@ [ ("Accept", "application/json") , ("X-Application", T.encodeUtf8 _apiKey) , ("X-Authentication", T.encodeUtf8 session_key) ] } - withHTTP req m $ \response -> do + withResponseBody req m $ \_ -> -- 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 @@ -281,29 +311,12 @@ ,("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 + withResponseBody req m $ \b -> + case decode $ BL.fromStrict 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 diff --git a/src/Network/Betfair/Types.hs b/src/Network/Betfair/Types.hs --- a/src/Network/Betfair/Types.hs +++ b/src/Network/Betfair/Types.hs @@ -5,7 +5,9 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE QuasiQuotes #-} -- | This module defines most data types in the betting API of Betfair API, @@ -45,16 +47,20 @@ module Network.Betfair.Types where +import Control.Applicative import Control.Monad.Catch import Control.Lens import Data.Aeson import Data.Aeson.TH import Data.Bet +import Data.Binary ( Binary, get, put ) +import Data.Data import Data.Text ( Text ) +import qualified Data.Text.Encoding as T import Data.Time -import Data.Typeable import qualified Data.Set as S import qualified Data.Map.Lazy as M +import GHC.Generics import Network.Betfair.Internal import Network.Betfair.Types.TH import Prelude hiding ( filter, id ) @@ -66,15 +72,19 @@ | ASomeBetsNotCancelled | ACancellationRequestError | ACancellationStatusUnknown - deriving ( Eq, Ord, Show, Read, Typeable, Enum ) + deriving ( Eq, Ord, Show, Read, Typeable, Enum, Data, Generic ) +instance Binary ActionPerformed + data BetStatus = Settled | Voided | Lapsed | Cancelled - deriving ( Eq, Ord, Show, Read, Typeable, Enum ) + deriving ( Eq, Ord, Show, Read, Typeable, Enum, Data, Generic ) +instance Binary BetStatus + data ExecutionReportErrorCode = RErrorInMatcher | RProcessedWithErrors @@ -93,23 +103,29 @@ | RNoActionRequired | RServiceUnavailable | RRejectedByRegulator - deriving ( Eq, Ord, Show, Read, Typeable, Enum ) + deriving ( Eq, Ord, Show, Read, Typeable, Enum, Data, Generic ) +instance Binary ExecutionReportErrorCode + data ExecutionReportStatus = ESuccess | EFailure | EProcessedWithErrors | ETimeout - deriving ( Eq, Ord, Show, Read, Typeable, Enum ) + deriving ( Eq, Ord, Show, Read, Typeable, Enum, Data, Generic ) +instance Binary ExecutionReportStatus + data GroupBy = GBEventType | GBEvent | GBMarket | GBSide | GBBet - deriving ( Eq, Ord, Show, Read, Typeable, Enum ) + deriving ( Eq, Ord, Show, Read, Typeable, Enum, Data, Generic ) +instance Binary GroupBy + data InstructionReportErrorCode = InvalidBetSize | InvalidRunner @@ -131,14 +147,18 @@ | CancelledNotPlaced | RelatedActionFailed | NoActionRequired - deriving ( Eq, Ord, Show, Read, Typeable, Enum ) + deriving ( Eq, Ord, Show, Read, Typeable, Enum, Data, Generic ) +instance Binary InstructionReportErrorCode + data InstructionReportStatus = Success | Failure | Timeout - deriving ( Eq, Ord, Show, Read, Typeable, Enum ) + deriving ( Eq, Ord, Show, Read, Typeable, Enum, Data, Generic ) +instance Binary InstructionReportStatus + data MarketBettingType = Odds | Line @@ -146,8 +166,10 @@ | AsianHandicapDoubleLine | AsianHandicapSingleLine | FixedOdds - deriving ( Eq, Ord, Show, Read, Typeable, Enum ) + deriving ( Eq, Ord, Show, Read, Typeable, Enum, Data, Generic ) +instance Binary MarketBettingType + data MarketProjection = Competition | Event @@ -156,8 +178,10 @@ | MarketDescription | RunnerDescription | RunnerMetadata - deriving ( Eq, Ord, Show, Read, Typeable, Enum ) + deriving ( Eq, Ord, Show, Read, Typeable, Enum, Data, Generic ) +instance Binary MarketProjection + data MarketSort = MinimumTraded | MaximumTraded @@ -165,21 +189,27 @@ | MaximumAvailable | FirstToStart | LastToStart - deriving ( Eq, Ord, Show, Read, Typeable, Enum ) + deriving ( Eq, Ord, Show, Read, Typeable, Enum, Data, Generic ) +instance Binary MarketSort + data MarketStatus = Inactive | Open | Suspended | Closed - deriving ( Eq, Ord, Show, Read, Typeable, Enum ) + deriving ( Eq, Ord, Show, Read, Typeable, Enum, Data, Generic ) +instance Binary MarketStatus + data MatchProjection = NoRollup | RolledUpByPrice | RolledUpByAvgPrice - deriving ( Eq, Ord, Show, Read, Typeable, Enum ) + deriving ( Eq, Ord, Show, Read, Typeable, Enum, Data, Generic ) +instance Binary MatchProjection + data OrderBy = ByBet | ByMarket @@ -187,46 +217,60 @@ | ByPlaceTime | BySettledTime | ByVoidTime - deriving ( Eq, Ord, Show, Read, Typeable, Enum ) + deriving ( Eq, Ord, Show, Read, Typeable, Enum, Data, Generic ) +instance Binary OrderBy + data OrderProjection = OpAll | OpExecutable | OpExecutionComplete - deriving ( Eq, Ord, Show, Read, Typeable, Enum ) + deriving ( Eq, Ord, Show, Read, Typeable, Enum, Data, Generic ) +instance Binary OrderProjection + data OrderStatus = ExecutionComplete | Executable - deriving ( Eq, Ord, Show, Read, Typeable, Enum ) + deriving ( Eq, Ord, Show, Read, Typeable, Enum, Data, Generic ) +instance Binary OrderStatus + data OrderType = Limit | LimitOnClose | MarketOnClose - deriving ( Eq, Ord, Show, Read, Typeable, Enum ) + deriving ( Eq, Ord, Show, Read, Typeable, Enum, Data, Generic ) +instance Binary OrderType + data PersistenceType = PtLapse | PtPersist | PtMarketOnClose - deriving ( Eq, Ord, Show, Read, Typeable, Enum ) + deriving ( Eq, Ord, Show, Read, Typeable, Enum, Data, Generic ) +instance Binary PersistenceType + data PriceData = SpAvailable | SpTraded | ExBestOffers | ExAllOffers | ExTraded - deriving ( Eq, Ord, Show, Read, Typeable, Enum ) + deriving ( Eq, Ord, Show, Read, Typeable, Enum, Data, Generic ) +instance Binary PriceData + data RollupModel = Stake | Payout | ManagedLiability | None - deriving ( Eq, Ord, Show, Read, Typeable, Enum ) + deriving ( Eq, Ord, Show, Read, Typeable, Enum, Data, Generic ) +instance Binary RollupModel + data RunnerStatus = Active | Winner @@ -234,59 +278,86 @@ | RemovedVacant | Removed | Hidden - deriving ( Eq, Ord, Show, Read, Typeable, Enum ) + deriving ( Eq, Ord, Show, Read, Typeable, Enum, Data, Generic ) +instance Binary RunnerStatus + type Side = BetType data SortDir = EarliestToLatest | LatestToEarliest - deriving ( Eq, Ord, Show, Read, Typeable, Enum ) + deriving ( Eq, Ord, Show, Read, Typeable, Enum, Data, Generic ) +instance Binary SortDir + data TimeGranularity = Days | Hours | Minutes - deriving ( Eq, Ord, Show, Read, Typeable, Enum ) + deriving ( Eq, Ord, Show, Read, Typeable, Enum, Data, Generic ) +instance Binary TimeGranularity newtype BetId = BetId { getBetId :: Text } - deriving ( Eq, Ord, Show, Read, Typeable, FromJSON, ToJSON ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic, FromJSON, ToJSON ) newtype Country = Country { getCountry :: Text } deriving ( Eq, Ord, Show, Read, Typeable - , FromJSON, ToJSON ) + , FromJSON, ToJSON, Data, Generic ) +instance Binary Country where + put (Country txt) = put $ WrappedText txt + get = Country . unwrapText <$> get + newtype CompetitionId = CompetitionId { getCompetitionId :: Text } deriving ( Eq, Ord, Show, Read, Typeable - , FromJSON, ToJSON ) + , FromJSON, ToJSON, Data, Generic ) +instance Binary CompetitionId where + put (CompetitionId txt) = put $ WrappedText txt + get = CompetitionId . unwrapText <$> get + newtype EventId = EventId { getEventId :: Text } deriving ( Eq, Ord, Show, Read, Typeable - , FromJSON, ToJSON ) + , FromJSON, ToJSON, Data, Generic ) +instance Binary EventId where + put (EventId txt) = put $ WrappedText txt + get = EventId . unwrapText <$> get + newtype EventTypeId = EventTypeId { getEventTypeId :: Text } deriving ( Eq, Ord, Show, Read, Typeable - , FromJSON, ToJSON ) + , FromJSON, ToJSON, Data, Generic ) +instance Binary EventTypeId where + put (EventTypeId txt) = put $ WrappedText txt + get = EventTypeId . unwrapText <$> get + newtype MarketId = MarketId { getMarketId :: Text } deriving ( Eq, Ord, Show, Read, Typeable - , FromJSON, ToJSON ) + , FromJSON, ToJSON, Data, Generic ) +instance Binary MarketId where + put (MarketId mid) = put $ T.encodeUtf8 mid + get = MarketId . T.decodeUtf8 <$> get + newtype MarketTypeCode = MarketTypeCode { getMarketTypeCode :: Text } deriving ( Eq, Ord, Show, Read, Typeable - , FromJSON, ToJSON ) + , FromJSON, ToJSON, Data, Generic ) newtype MatchId = MatchId { getMatchId :: Text } - deriving ( Eq, Ord, Show, Read, Typeable, FromJSON, ToJSON ) + deriving ( Eq, Ord, Show, Read, Typeable, FromJSON, ToJSON, Data, Generic ) newtype SelectionId = SelectionId { getSelectionId :: Int } deriving ( Eq, Ord, Show, Read, Typeable - , FromJSON, ToJSON ) + , FromJSON, ToJSON, Data, Generic ) +instance Binary SelectionId + newtype Venue = Venue { getVenue :: Text } deriving ( Eq, Ord, Show, Read, Typeable - , FromJSON, ToJSON ) + , FromJSON, ToJSON, Data, Generic ) data CancelExecutionReport = CancelExecutionReportC { ceCustomerRef :: Maybe Text @@ -294,12 +365,12 @@ , ceErrorCode :: Maybe ExecutionReportErrorCode , ceMarketId :: Maybe MarketId , ceInstructionReports :: [CancelInstructionReport] } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data CancelInstruction = CancelInstructionC { ciBetId :: BetId , ciSizeReduction :: Maybe Double } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data CancelInstructionReport = CancelInstructionReportC { ciStatus :: InstructionReportStatus @@ -307,13 +378,13 @@ , ciInstruction :: Maybe CancelInstruction , ciSizeCancelled :: Double , ciCancelledDate :: Maybe UTCTime } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data CancelOrders = CancelOrdersC { caMarketId :: Maybe MarketId , caInstructions :: Maybe [CancelInstruction] , caCustomerRef :: Maybe Text } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data ClearedOrderSummary = ClearedOrderSummaryC { coEventTypeId :: EventTypeId @@ -336,28 +407,36 @@ , coSizeSettled :: Maybe Double , coProfit :: Double , coSizeCancelled :: Maybe Double } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data Competition = CompetitionC { cId :: CompetitionId , cName :: Text } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) +instance Binary Competition where + put (CompetitionC{..}) = do + put cId + put (WrappedText cName) + get = CompetitionC <$> + get <*> + (unwrapText <$> get) + data CompetitionResult = CompetitionResultC { cCompetition :: Competition , cMarketCount :: Int , cCompetitionRegion :: Text } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data CountryCodeResult = CountryCodeResultC { ccCountryCode :: Text , ccMarketCount :: Int } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data ClearedOrderSummaryReport = ClearedOrderSummaryReportC { coClearedOrders :: [ClearedOrderSummary] , coMoreAvailable :: Bool } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data CurrentOrderSummary = CurrentOrderSummaryC { cBetId :: BetId @@ -380,12 +459,12 @@ , cSizeVoided :: Maybe Double , cRegulatorAuthCode :: Maybe Text , cRegulatorCode :: Maybe Text } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data CurrentOrderSummaryReport = CurrentOrderSummaryReportC { cCurrentOrders :: [CurrentOrderSummary] , cMoreAvailable :: Bool } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data ExBestOffersOverrides = ExBestOffersOverridesC { ebbestPricesDepth :: Maybe Int @@ -393,13 +472,13 @@ , ebRollupLimit :: Maybe Int , ebRollupLiabilityThreshold :: Maybe Double , ebRollupLiabilityFactor :: Maybe Int } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data ExchangePrices = ExchangePricesC { epAvailableToBack :: Maybe [PriceSize] , epAvailableToLay :: Maybe [PriceSize] , epTradedVolume :: Maybe [PriceSize] } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data Event = EventC { eId :: EventId @@ -408,31 +487,59 @@ , eTimezone :: Text , eVenue :: Maybe Text , eOpenDate :: UTCTime } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) +instance Binary Event where + put (EventC{..}) = do + put eId + put (WrappedText eName) + put eCountryCode + put (WrappedText eTimezone) + put (fmap WrappedText eVenue) + put (WrappedUTCTime eOpenDate) + get = EventC <$> + get <*> + (unwrapText <$> get) <*> + get <*> + (unwrapText <$> get) <*> + (fmap unwrapText <$> get) <*> + (unwrapUTCTime <$> get) + data EventResult = EventResultC { erEvent :: Event , erMarketCount :: Int } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data EventType = EventTypeC { etId :: EventTypeId , etName :: Text } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) +instance Binary EventType where + put (EventTypeC {..}) = do + put etId + put (WrappedText etName) + get = EventTypeC <$> + get <*> + (unwrapText <$> get) + data EventTypeResult = EventTypeResultC { etrEventType :: EventType , etrMarketCount :: Int } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) +instance Binary EventTypeResult + newtype Heartbeat = HeartbeatC { hPreferredTimeoutSeconds :: Int } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) +instance Binary Heartbeat + data HeartbeatReport = HeartbeatReportC { hActionPerformed :: ActionPerformed , hActualTimeoutSeconds :: Int } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data ItemDescription = ItemDescriptionC { iEventTypeDesc :: Maybe Text @@ -441,28 +548,28 @@ , iMarketStartTime :: Maybe UTCTime , iRunnerDesc :: Maybe Text , iNumberOfWinners :: Maybe Int } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data LimitOnCloseOrder = LimitOnCloseOrderC { loLiability :: Double , loPrice :: Double } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data LimitOrder = LimitOrderC { lSize :: Double , lPrice :: Double , lPersistenceType :: PersistenceType } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data ListCompetitions = ListCompetitionsC { lcFilter :: MarketFilter , lcLocale :: Maybe Text } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data ListCountries = ListCountriesC { lcsFilter :: MarketFilter , lcsLocale :: Maybe Text } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data ListCurrentOrders = ListCurrentOrdersC { lcoBetIds :: Maybe (S.Set BetId) @@ -473,7 +580,7 @@ , lcoSortDir :: Maybe SortDir , lcoFromRecord :: Maybe Int , lcoRecordCount :: Maybe Int } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data ListClearedOrders = ListClearedOrdersC { lcrBetStatus :: BetStatus @@ -489,17 +596,17 @@ , lcrLocale :: Maybe Text , lcrFromRecord :: Maybe Int , lcrRecordCount :: Maybe Int } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data ListEvents = ListEventsC { leFilter :: MarketFilter , leLocale :: Maybe Text } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data ListEventTypes = ListEventTypesC { letFilter :: MarketFilter , letLocale :: Maybe Text } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data ListMarketBook = ListMarketBookC { lmbMarketIds :: [MarketId] @@ -508,7 +615,7 @@ , lmbMatchProjection :: Maybe MatchProjection , lmbCurrencyCode :: Maybe Text , lmbLocale :: Maybe Text } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data ListMarketCatalogue = ListMarketCatalogueC { lmcFilter :: MarketFilter @@ -516,29 +623,29 @@ , lmcSort :: Maybe MarketSort , lmcMaxResults :: Int , lmcLocale :: Maybe Text } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data ListMarketProfitAndLoss = ListMarketProfitAndLossC { lmMarketIds :: S.Set MarketId , lmIncludeSettledBets :: Maybe Bool , lmIncludeBspBets :: Maybe Bool , lmNetOfCommission :: Maybe Bool } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data ListMarketTypes = ListMarketTypesC { lmtFilter :: MarketFilter , lmtLocale :: Maybe Text } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data ListTimeRanges = ListTimeRangesC { ltFilter :: MarketFilter , ltGranularity :: TimeGranularity } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data ListVenues = ListVenuesC { lvFilter :: MarketFilter , lvLocale :: Maybe Text } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data MarketBook = MarketBookC { mbMarketId :: MarketId @@ -558,7 +665,7 @@ , mbRunnersVoidable :: Maybe Bool , mbVersion :: Maybe Int , mbRunners :: [Runner] } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data MarketCatalogue = MarketCatalogueC { mcMarketId :: MarketId @@ -570,8 +677,54 @@ , mcEventType :: Maybe EventType , mcCompetition :: Maybe Competition , mcEvent :: Maybe Event } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) +-- | A newtype wrapper `Text`. This exists because we don't want to introduce an +-- orphan instance `Binary` for `Text`. +newtype WrappedText = WrappedText { unwrapText :: Text } + +instance Binary WrappedText where + put (WrappedText txt) = put $ T.encodeUtf8 txt + get = WrappedText . T.decodeUtf8 <$> get + +-- | A newtype wrapper around `UTCTime`. This exists because we don't want to +-- introduce an orphan instance `Binary` for `UTCTime`. +newtype WrappedUTCTime = WrappedUTCTime { unwrapUTCTime :: UTCTime } + +instance Binary WrappedUTCTime where + put (WrappedUTCTime (UTCTime (ModifiedJulianDay jl) dt)) = do + put jl + put (toRational dt) + + get = do + u <- UTCTime <$> + (ModifiedJulianDay <$> get) <*> + (fromRational <$> get) + return $ WrappedUTCTime u + +instance Binary MarketCatalogue where + put (MarketCatalogueC{..}) = do + put mcMarketId + put (T.encodeUtf8 mcMarketName) + put (WrappedUTCTime <$> mcMarketStartTime) + put mcDescription + put mcTotalMatched + put mcRunners + put mcEventType + put mcCompetition + put mcEventType + + get = MarketCatalogueC <$> + get <*> + (T.decodeUtf8 <$> get) <*> + (fmap unwrapUTCTime <$> get) <*> + get <*> + get <*> + get <*> + get <*> + get <*> + get + data MarketDescription = MarketDescriptionC { mdPersistenceEnabled :: Bool , mdBspMarket :: Bool @@ -588,8 +741,42 @@ , mdRules :: Maybe Text , mdRulesHasDate :: Maybe Bool , mdClarifications :: Maybe Text } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) +instance Binary MarketDescription where + put (MarketDescriptionC{..}) = do + put mdPersistenceEnabled + put mdBspMarket + put (WrappedUTCTime mdMarketTime) + put (WrappedUTCTime mdSuspendTime) + put (WrappedUTCTime <$> mdSettleTime) + put mdBettingType + put mdTurnInPlayEnabled + put (WrappedText mdMarketType) + put (WrappedText mdRegulator) + put mdMarketBaseRate + put mdDiscountAllowed + put (WrappedText <$> mdWallet) + put (WrappedText <$> mdRules) + put mdRulesHasDate + put (WrappedText <$> mdClarifications) + get = MarketDescriptionC <$> + get <*> + get <*> + (unwrapUTCTime <$> get) <*> + (unwrapUTCTime <$> get) <*> + (fmap unwrapUTCTime <$> get) <*> + get <*> + get <*> + (unwrapText <$> get) <*> + (unwrapText <$> get) <*> + get <*> + get <*> + (fmap unwrapText <$> get) <*> + (fmap unwrapText <$> get) <*> + get <*> + (fmap unwrapText <$> get) + data MarketFilter = MarketFilterC { mfTextQuery :: Maybe String , mfEventTypeIds :: Maybe (S.Set EventTypeId) @@ -605,22 +792,22 @@ , mfMarketTypeCodes :: Maybe (S.Set MarketTypeCode) , mfMarketStartTime :: Maybe TimeRange , mfWithOrders :: Maybe (S.Set OrderStatus) } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) newtype MarketOnCloseOrder = MarketOnCloseOrderC { mLiability :: Double } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data MarketProfitAndLoss = MarketProfitAndLossC { mpMarketId :: Maybe MarketId , mpCommissionApplied :: Maybe Double , mpProfitAndLosses :: Maybe [RunnerProfitAndLoss] } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data MarketTypeResult = MarketTypeResultC { mtMarketType :: Text , mtMarketCount :: Int } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data Match = MatchC { mBetId :: Maybe BetId @@ -629,7 +816,7 @@ , mPrice :: Double , mSize :: Double , mMatchDate :: Maybe UTCTime } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data Order = OrderC { oBetId :: BetId @@ -647,7 +834,7 @@ , oSizeLapsed :: Maybe Double , oSizeCancelled :: Maybe Double , oSizeVoided :: Maybe Double } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data PlaceExecutionReport = PlaceExecutionReportC { peCustomerRef :: Maybe Text @@ -655,7 +842,7 @@ , peErrorCode :: Maybe ExecutionReportErrorCode , peMarketId :: Maybe MarketId , peInstructionReports :: Maybe [PlaceInstructionReport] } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data PlaceInstruction = PlaceInstructionC { pOrderType :: OrderType @@ -665,7 +852,7 @@ , pLimitOrder :: Maybe LimitOrder , pLimitOnCloseOrder :: Maybe LimitOnCloseOrder , pMarketOnCloseOrder :: Maybe MarketOnCloseOrder } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data PlaceInstructionReport = PlaceInstructionReportC { piStatus :: InstructionReportStatus @@ -675,51 +862,53 @@ , piPlacedDate :: Maybe UTCTime , piAveragePriceMatched :: Maybe Double , piSizeMatched :: Maybe Double } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data PlaceOrders = PlaceOrdersC { pMarketId :: MarketId , pInstructions :: [PlaceInstruction] , pCustomerRef :: Maybe Text } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data PriceProjection = PriceProjectionC { ppPriceData :: Maybe (S.Set PriceData) , ppExBestOffersOverrides :: Maybe ExBestOffersOverrides , ppVirtualize :: Maybe Bool , ppRolloverStakes :: Maybe Bool } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data PriceSize = PriceSizeC { psPrice :: Double , psSize :: Double } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) +instance Binary PriceSize + data ReplaceExecutionReport = ReplaceExecutionReportC { reCustomerRef :: Maybe Text , reStatus :: ExecutionReportStatus , reErrorCode :: Maybe ExecutionReportErrorCode , reMarketId :: Maybe Text , reInstructionReports :: Maybe [ReplaceInstructionReport] } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data ReplaceInstruction = ReplaceInstructionC { rBetId :: BetId , rNewPrice :: Double } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data ReplaceInstructionReport = ReplaceInstructionReportC { riStatus :: InstructionReportStatus , riErrorCode :: Maybe InstructionReportErrorCode , riCancelInstructionReport :: Maybe CancelInstructionReport , riPlaceInstructionReport :: Maybe PlaceInstructionReport } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data ReplaceOrders = ReplaceOrdersC { rMarketId :: MarketId , rInstructions :: [ReplaceInstruction] , rCustomerRef :: Maybe Text } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data Runner = RunnerC { rSelectionId :: SelectionId @@ -735,27 +924,41 @@ , rEx :: Maybe ExchangePrices , rOrders :: Maybe [Order] , rMatches :: Maybe [Match] } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data RunnerCatalog = RunnerCatalogC { rcSelectionId :: SelectionId , rcRunnerName :: Text , rcHandicap :: Double - , rcSortPriority :: Int - , rcMetadata :: M.Map Text Text } - deriving ( Eq, Ord, Show, Read, Typeable ) + , rcSortPriority :: Maybe Int + , rcMetadata :: Maybe (M.Map Text Text) } + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) +instance Binary RunnerCatalog where + put (RunnerCatalogC{..}) = do + put rcSelectionId + put (WrappedText rcRunnerName) + put rcHandicap + put rcSortPriority + put (M.map WrappedText . M.mapKeysMonotonic WrappedText <$> rcMetadata) + get = RunnerCatalogC <$> + get <*> + (unwrapText <$> get) <*> + get <*> + get <*> + (fmap (M.map unwrapText . M.mapKeysMonotonic unwrapText) <$> get) + data RunnerId = RunnerIdC { riMarketId :: MarketId , riSelectionId :: SelectionId , riHandicap :: Maybe Double } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data RunnerProfitAndLoss = RunnerProfitAndLossC { rpSelectionId :: Maybe SelectionId , rpIfWin :: Maybe Double , rpIfLose :: Maybe Double } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data StartingPrices = StartingPricesC { spNearPrice :: Maybe Double @@ -763,17 +966,17 @@ , spBackStakeTaken :: Maybe [PriceSize] , spLayLiabilityTaken :: Maybe [PriceSize] , spActualSP :: Maybe Double } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data TimeRange = TimeRangeC { tFrom :: UTCTime , tTo :: UTCTime } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data TimeRangeResult = TimeRangeResultC { tTimeRange :: TimeRange , tMarketCount :: Int } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data UpdateExecutionReport = UpdateExecutionReportC { ueCustomerRef :: Maybe Text @@ -781,33 +984,33 @@ , ueErrorCode :: Maybe ExecutionReportErrorCode , ueMarketId :: Maybe Text , ueInstructionReports :: Maybe [UpdateInstructionReport] } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data UpdateInstruction = UpdateInstructionC { uBetId :: BetId , uNewPersistenceType :: PersistenceType } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data UpdateInstructionReport = UpdateInstructionReportC { uiStatus :: InstructionReportStatus , uiErrorCode :: Maybe InstructionReportErrorCode , uiInstruction :: UpdateInstruction } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data UpdateOrders = UpdateOrdersC { uMarketId :: MarketId , uInstructions :: [UpdateInstruction] , uCustomerRef :: Maybe Text } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data VenueResult = VenueResultC { vVenue :: Text , vMarketCount :: Int } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) data APIException = APIException { exceptionDetails :: Text , exceptionCode :: APIExceptionCode } - deriving ( Eq, Ord, Show, Read, Typeable ) + deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic ) instance Exception APIException @@ -828,7 +1031,7 @@ | TimeoutError | RequestSizeExceedsLimit | AccessDenied - deriving ( Eq, Ord, Show, Read, Typeable, Enum ) + deriving ( Eq, Ord, Show, Read, Typeable, Enum, Data, Generic ) makeLensesWith abbreviatedFields ''CancelExecutionReport makeLensesWith abbreviatedFields ''CancelInstruction