From 0eee9eb65b54e6b33bcacd646eef4dfe497b8d4d Mon Sep 17 00:00:00 2001
From: Alexander Bondarenko <486682+dpwiz@users.noreply.github.com>
Date: Fri, 19 Apr 2024 13:06:32 +0300
Subject: [PATCH] revert String encoding, discard invalid errors in QC

---
 src/Simplex/Messaging/Encoding/String.hs |  8 ++++----
 tests/CoreTests/ProtocolErrorTests.hs    | 19 ++++++++++++-------
 2 files changed, 16 insertions(+), 11 deletions(-)

diff --git a/src/Simplex/Messaging/Encoding/String.hs b/src/Simplex/Messaging/Encoding/String.hs
index e72c21c27..6b9fb5624 100644
--- a/src/Simplex/Messaging/Encoding/String.hs
+++ b/src/Simplex/Messaging/Encoding/String.hs
@@ -32,7 +32,6 @@ import qualified Data.List.NonEmpty as L
 import Data.Set (Set)
 import qualified Data.Set as S
 import Data.Text (Text)
-import qualified Data.Text as T
 import Data.Text.Encoding (decodeLatin1, encodeUtf8)
 import Data.Time.Clock (UTCTime)
 import Data.Time.Clock.System (SystemTime (..))
@@ -40,7 +39,7 @@ import Data.Time.Format.ISO8601
 import Data.Word (Word16, Word32)
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Parsers (parseAll)
-import Simplex.Messaging.Util (safeDecodeUtf8, (<$?>))
+import Simplex.Messaging.Util ((<$?>))
 
 class TextEncoding a where
   textEncode :: a -> Text
@@ -77,9 +76,10 @@ instance StrEncoding Str where
   strP = Str <$> A.takeTill (== ' ') <* optional A.space
 
 -- inherited from ByteString, the parser only allows non-empty strings
+-- only Char8 elements may round-trip as B.pack truncates unicode
 instance StrEncoding String where
-  strEncode = strEncode . encodeUtf8 . T.pack
-  strP = T.unpack . safeDecodeUtf8 <$> strP
+  strEncode = strEncode . B.pack
+  strP = B.unpack <$> strP
 
 instance ToJSON Str where
   toJSON (Str s) = strToJSON s
diff --git a/tests/CoreTests/ProtocolErrorTests.hs b/tests/CoreTests/ProtocolErrorTests.hs
index a486e6549..8f5ad70e7 100644
--- a/tests/CoreTests/ProtocolErrorTests.hs
+++ b/tests/CoreTests/ProtocolErrorTests.hs
@@ -17,6 +17,7 @@ import qualified Simplex.Messaging.Agent.Protocol as Agent
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (CommandError (..), ErrorType (..), ProxyError (..))
+import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Transport (HandshakeError (..), TransportError (..))
 import Simplex.RemoteControl.Types (RCErrorType (..))
 import Test.Hspec
@@ -28,15 +29,19 @@ protocolErrorTests = modifyMaxSuccess (const 1000) $ do
   describe "errors parsing / serializing" $ do
     it "should parse SMP protocol errors" . property $ \(err :: ErrorType) ->
       smpDecode (smpEncode err) == Right err
-    it "should parse SMP agent errors" . property $ \(err :: AgentErrorType) ->
-      errHasSpaces err
-        || strDecode (strEncode err) == Right err
+    it "should parse SMP agent errors" . property . forAll possible $ \err ->
+      strDecode (strEncode err) == Right err
   where
-    errHasSpaces = \case
-      BROKER srv (Agent.RESPONSE e) -> hasSpaces srv || hasSpaces e
-      BROKER srv _ -> hasSpaces srv
-      _ -> False
+    possible :: Gen AgentErrorType
+    possible =
+      arbitrary >>= \case
+        BROKER srv (Agent.RESPONSE e) | hasSpaces srv || hasSpaces e -> discard
+        BROKER srv _ | hasSpaces srv -> discard
+        SMP (PROXY (SMP.UNEXPECTED s)) | hasUnicode s -> discard
+        NTF (PROXY (SMP.UNEXPECTED s)) | hasUnicode s -> discard
+        ok -> pure ok
     hasSpaces s = ' ' `B.elem` encodeUtf8 (T.pack s)
+    hasUnicode = any (>= '\255')
 
 deriving instance Generic AgentErrorType