module Network.MtGoxAPI.TickerMonitor
( initTickerMonitor
, getTickerStatus
, updateTickerStatus
, TickerStatus(..)
, TickerMonitorHandle
) where
import Control.Applicative
import Control.Concurrent
import Control.Watchdog
import Data.Time.Clock
import Network.MtGoxAPI.Types
newtype TickerMonitorHandle = TickerMonitorHandle
{ unTMH :: MVar (Maybe TickerStatus) }
data TickerStatus = TickerStatus { tsTimestamp :: UTCTime
, tsBid :: Integer
, tsAsk :: Integer
, tsLast :: Integer
, tsPrecision :: Integer
}
| TickerUnavailable
deriving (Show)
expectedPrecision :: Integer
expectedPrecision = 5
maximumAgeInSeconds :: NominalDiffTime
maximumAgeInSeconds = 300
watchdogSettings :: WatchdogAction ()
watchdogSettings = do
setLoggingAction silentLogger
setInitialDelay 250000
setMaximumRetries 6
getTickerStatus :: TickerMonitorHandle -> IO TickerStatus
getTickerStatus TickerMonitorHandle { unTMH = store } = do
let task = getTickerStatus' store
result <- watchdog $ do
watchdogSettings
watchImpatiently task
return $ case result of
Left _ -> TickerUnavailable
Right status -> status
getTickerStatus' :: MVar (Maybe TickerStatus) -> IO (Either String TickerStatus)
getTickerStatus' store = do
tickerStatusM <- readMVar store
case tickerStatusM of
Nothing -> return $ Left "No ticker data present"
Just tickerStatus -> do
now <- getCurrentTime
let age = diffUTCTime now (tsTimestamp tickerStatus)
return $ if age < maximumAgeInSeconds
then Right tickerStatus
else Left "Data stale"
updateTickerStatus :: TickerMonitorHandle -> StreamMessage -> IO ()
updateTickerStatus TickerMonitorHandle { unTMH = tickerStore }
(update@TickerUpdateUSD {}) = do
now <- getCurrentTime
let tickerStatus = TickerStatus { tsTimestamp = now
, tsBid = tuBid update
, tsAsk = tuAsk update
, tsLast = tuLast update
, tsPrecision = expectedPrecision
}
_ <- swapMVar tickerStore (Just tickerStatus)
return ()
updateTickerStatus _ _ = return ()
initTickerMonitor :: IO TickerMonitorHandle
initTickerMonitor = TickerMonitorHandle <$> newMVar Nothing