Browse Source

Replace corrupted utf-8 sequences with '?'

master
Denis Tereshkin 3 years ago
parent
commit
4d2dc0c096
  1. 6
      src/TXML.hs
  2. 17
      src/TXMLConnector.hs
  3. 4
      src/TickerInfoServer.hs

6
src/TXML.hs

@ -52,7 +52,7 @@ strErrorStringToResult str =
if nullPtr /= str if nullPtr /= str
then do then do
packed <- BS.packCString str packed <- BS.packCString str
let result = decodeUtf8With lenientDecode $ packed let result = decodeUtf8With (replace '?') $ packed
_ <- c_FreeMemory str _ <- c_FreeMemory str
pure $ Left result pure $ Left result
else else
@ -63,7 +63,7 @@ rawStringToResult str =
if nullPtr /= str if nullPtr /= str
then do then do
packed <- BS.packCString str packed <- BS.packCString str
let result = decodeUtf8With lenientDecode $ packed let result = decodeUtf8With (replace '?') $ packed
_ <- c_FreeMemory str _ <- c_FreeMemory str
if "<result success=\"true\"/>" `T.isPrefixOf` result if "<result success=\"true\"/>" `T.isPrefixOf` result
then pure $ Right () then pure $ Right ()
@ -89,7 +89,7 @@ setCallback callback = do
wrappedCallback <- createCallbackPtr (\x -> do wrappedCallback <- createCallbackPtr (\x -> do
packed <- BS.packCString x packed <- BS.packCString x
boolToCBool <$> (callback $ boolToCBool <$> (callback $
decodeUtf8With lenientDecode decodeUtf8With (replace '?')
packed)) packed))
ret <- c_SetCallback wrappedCallback ret <- c_SetCallback wrappedCallback
if ret /= 0 if ret /= 0

17
src/TXMLConnector.hs

@ -2,9 +2,6 @@
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}
module TXMLConnector module TXMLConnector
( (
@ -431,8 +428,22 @@ workThread = do
modifyTVar' (bsOrderTransactionIdMap brState) (BM.insert (orderId order) (TransactionId transactionId)) modifyTVar' (bsOrderTransactionIdMap brState) (BM.insert (orderId order) (TransactionId transactionId))
resp <- readTMVar respVar resp <- readTMVar respVar
putTMVar resp ResponseOrderSubmitted 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: " <> log Debug "TXMLConnector.WorkThread" $ "Inserting orderid: " <>
(T.pack . show) (orderId order) <> " <-> " <> (T.pack . show) transactionId (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" _ -> log Warning "TXMLConnector.WorkThread" "Unable to parse result"
Right _ -> do Right _ -> do
log Warning "TXMLConnector.WorkThread" "Expected result, got nothing" log Warning "TXMLConnector.WorkThread" "Expected result, got nothing"

4
src/TickerInfoServer.hs

@ -32,7 +32,7 @@ import Data.List.NonEmpty (NonEmpty ((:|)))
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import qualified Data.Text as T import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8With, encodeUtf8) import Data.Text.Encoding (decodeUtf8With, encodeUtf8)
import Data.Text.Encoding.Error (lenientDecode) import Data.Text.Encoding.Error (replace)
import Prelude hiding (log) import Prelude hiding (log)
import System.ZMQ4 (Context, Router (Router), bind, import System.ZMQ4 (Context, Router (Router), bind,
connect, receiveMulti, sendMulti, connect, receiveMulti, sendMulti,
@ -103,7 +103,7 @@ startTickerInfoServer logger ctx endpoint = do
sendMulti sock (sender :| ["", "ERROR"]) sendMulti sock (sender :| ["", "ERROR"])
Left err -> do Left err -> do
log Warning "TIS" $ "Unable to parse incoming request" <> (T.pack . show) err 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" _ -> log Warning "TIS" "Malformed packet"
readTVarIO tisRun readTVarIO tisRun

Loading…
Cancel
Save