Fix TIS operation

src/TickerInfoServer.hs

@@ -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)
 import           Control.Exception           (bracket)
 import           Control.Monad.Extra         (whileM)
 import           Data.Aeson                  (FromJSON (parseJSON),
-                                              ToJSON (toJSON), decode, encode,
+                                              ToJSON (toJSON), decode,
-                                              object, withObject)
+                                              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
 import           Data.Text.Encoding          (decodeUtf8With, encodeUtf8)
 import           Data.Text.Encoding.Error    (lenientDecode)
 import           Prelude                     hiding (log)
-import           System.ZMQ4                 (Context, Router (Router), connect,
+import           System.ZMQ4                 (Context, Router (Router), bind,
-                                              receiveMulti, sendMulti,
+                                              connect, receiveMulti, sendMulti,
                                               withSocket)
 
 data TickerInfo =
@@ -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
+          (sender:_:message:_) -> case eitherDecode (BL.fromStrict message) of
-            Just tir -> do
+            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"])
+                  sendMulti sock (sender :| ["", "ERROR"])
-            _ -> log Warning "TIS" "Unable to parse incoming request"
+            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