|
|
|
|
@ -10,7 +10,8 @@ module TickerInfoServer
@@ -10,7 +10,8 @@ module TickerInfoServer
|
|
|
|
|
getTickerInfo, |
|
|
|
|
TickerInfo(..) |
|
|
|
|
) where |
|
|
|
|
import ATrade.Logging (Message, Severity (Warning), |
|
|
|
|
import ATrade.Logging (Message, |
|
|
|
|
Severity (Debug, Warning), |
|
|
|
|
logWith) |
|
|
|
|
import ATrade.Types (Tick, TickerId, security) |
|
|
|
|
import Colog (LogAction) |
|
|
|
|
@ -21,8 +22,9 @@ import Control.Concurrent.STM.TVar (modifyTVar', writeTVar)
@@ -21,8 +22,9 @@ import Control.Concurrent.STM.TVar (modifyTVar', writeTVar)
|
|
|
|
|
import Control.Exception (bracket) |
|
|
|
|
import Control.Monad.Extra (whileM) |
|
|
|
|
import Data.Aeson (FromJSON (parseJSON), |
|
|
|
|
ToJSON (toJSON), decode, encode, |
|
|
|
|
object, withObject) |
|
|
|
|
ToJSON (toJSON), decode, |
|
|
|
|
eitherDecode, encode, object, |
|
|
|
|
withObject) |
|
|
|
|
import Data.Aeson.Types ((.:), (.=)) |
|
|
|
|
import qualified Data.ByteString.Lazy as BL |
|
|
|
|
import Data.List.NonEmpty (NonEmpty ((:|))) |
|
|
|
|
@ -31,8 +33,8 @@ import qualified Data.Text as T
@@ -31,8 +33,8 @@ import qualified Data.Text as T
|
|
|
|
|
import Data.Text.Encoding (decodeUtf8With, encodeUtf8) |
|
|
|
|
import Data.Text.Encoding.Error (lenientDecode) |
|
|
|
|
import Prelude hiding (log) |
|
|
|
|
import System.ZMQ4 (Context, Router (Router), connect, |
|
|
|
|
receiveMulti, sendMulti, |
|
|
|
|
import System.ZMQ4 (Context, Router (Router), bind, |
|
|
|
|
connect, receiveMulti, sendMulti, |
|
|
|
|
withSocket) |
|
|
|
|
|
|
|
|
|
data TickerInfo = |
|
|
|
|
@ -86,19 +88,21 @@ startTickerInfoServer logger ctx endpoint = do
@@ -86,19 +88,21 @@ startTickerInfoServer logger ctx endpoint = do
|
|
|
|
|
where |
|
|
|
|
log = logWith logger |
|
|
|
|
tisThread tisRun tisMap = withSocket ctx Router $ \sock -> do |
|
|
|
|
connect sock (T.unpack endpoint) |
|
|
|
|
bind sock (T.unpack endpoint) |
|
|
|
|
whileM $ do |
|
|
|
|
rq <- receiveMulti sock |
|
|
|
|
case rq of |
|
|
|
|
(sender:message:_) -> case decode (BL.fromStrict message) of |
|
|
|
|
Just tir -> do |
|
|
|
|
(sender:_:message:_) -> case eitherDecode (BL.fromStrict message) of |
|
|
|
|
Right tir -> do |
|
|
|
|
maybeTi <- M.lookup (tirTickerId tir) <$> readTVarIO tisMap |
|
|
|
|
case maybeTi of |
|
|
|
|
Just ti -> sendMulti sock (sender :| ["OK", BL.toStrict $ encode ti]) |
|
|
|
|
Just ti -> sendMulti sock (sender :| ["", "OK", BL.toStrict $ encode ti]) |
|
|
|
|
_ -> do |
|
|
|
|
log Warning "TIS" $ "Requested unknown ticker: " <> tirTickerId tir |
|
|
|
|
sendMulti sock (sender :| ["ERROR"]) |
|
|
|
|
_ -> log Warning "TIS" "Unable to parse incoming request" |
|
|
|
|
sendMulti sock (sender :| ["", "ERROR"]) |
|
|
|
|
Left err -> do |
|
|
|
|
log Warning "TIS" $ "Unable to parse incoming request" <> (T.pack . show) err |
|
|
|
|
log Debug "TIS" $ "Request: " <> decodeUtf8With lenientDecode message |
|
|
|
|
_ -> log Warning "TIS" "Malformed packet" |
|
|
|
|
readTVarIO tisRun |
|
|
|
|
|
|
|
|
|
|