diff --git a/src/TXML.hs b/src/TXML.hs index 4d43c82..4952b9e 100644 --- a/src/TXML.hs +++ b/src/TXML.hs @@ -52,7 +52,7 @@ strErrorStringToResult str = if nullPtr /= str then do packed <- BS.packCString str - let result = decodeUtf8With lenientDecode $ packed + let result = decodeUtf8With (replace '?') $ packed _ <- c_FreeMemory str pure $ Left result else @@ -63,7 +63,7 @@ rawStringToResult str = if nullPtr /= str then do packed <- BS.packCString str - let result = decodeUtf8With lenientDecode $ packed + let result = decodeUtf8With (replace '?') $ packed _ <- c_FreeMemory str if "" `T.isPrefixOf` result then pure $ Right () @@ -89,7 +89,7 @@ setCallback callback = do wrappedCallback <- createCallbackPtr (\x -> do packed <- BS.packCString x boolToCBool <$> (callback $ - decodeUtf8With lenientDecode + decodeUtf8With (replace '?') packed)) ret <- c_SetCallback wrappedCallback if ret /= 0 diff --git a/src/TXMLConnector.hs b/src/TXMLConnector.hs index 8deb01b..5001cef 100644 --- a/src/TXMLConnector.hs +++ b/src/TXMLConnector.hs @@ -2,9 +2,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedLabels #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TypeApplications #-} module TXMLConnector ( @@ -431,8 +428,22 @@ workThread = do modifyTVar' (bsOrderTransactionIdMap brState) (BM.insert (orderId order) (TransactionId transactionId)) resp <- readTMVar respVar putTMVar resp ResponseOrderSubmitted + maybeCb <- liftIO $ readTVarIO (bsNotificationCallback brState) + case maybeCb of + Just cb -> do + let notif = BackendOrderNotification (orderId order) Submitted + liftIO $ cb notif + _ -> pure () log Debug "TXMLConnector.WorkThread" $ "Inserting orderid: " <> (T.pack . show) (orderId order) <> " <-> " <> (T.pack . show) transactionId + Just (TransaqResponseResult (ResponseFailure err)) -> do + log Debug "TXMLConnector.WorkThread" $ "Order submission failure: " <> err + maybeCb <- liftIO $ readTVarIO (bsNotificationCallback brState) + case maybeCb of + Just cb -> do + let notif = BackendOrderNotification (orderId order) Rejected + liftIO $ cb notif + _ -> pure () _ -> log Warning "TXMLConnector.WorkThread" "Unable to parse result" Right _ -> do log Warning "TXMLConnector.WorkThread" "Expected result, got nothing" diff --git a/src/TickerInfoServer.hs b/src/TickerInfoServer.hs index 37d9640..e163c8b 100644 --- a/src/TickerInfoServer.hs +++ b/src/TickerInfoServer.hs @@ -32,7 +32,7 @@ import Data.List.NonEmpty (NonEmpty ((:|))) import qualified Data.Map.Strict as M import qualified Data.Text as T import Data.Text.Encoding (decodeUtf8With, encodeUtf8) -import Data.Text.Encoding.Error (lenientDecode) +import Data.Text.Encoding.Error (replace) import Prelude hiding (log) import System.ZMQ4 (Context, Router (Router), bind, connect, receiveMulti, sendMulti, @@ -103,7 +103,7 @@ startTickerInfoServer logger ctx endpoint = do 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 Debug "TIS" $ "Request: " <> decodeUtf8With (replace '?') message _ -> log Warning "TIS" "Malformed packet" readTVarIO tisRun