Replace Data.Binary with Chainweb.Utils.Serialization

src/Chainweb/Pact/SPV/Hyperlane.hs

@@ -11,18 +11,15 @@ import Control.Monad (when)
 import Control.Monad.Catch
 import Control.Monad.Except
 
-import Data.Foldable (foldl')
-import Data.DoubleWord
-import Data.Decimal
-import Data.Ratio
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Builder as Builder
-import Data.Default (def)
 import qualified Data.ByteString.Base16 as B16
 import qualified Data.ByteString.Short as BS
-import qualified Data.ByteString.Lazy as BL
-import qualified Data.Binary as Binary
-import qualified Data.Binary.Put as Binary
+import Data.DoubleWord
+import Data.Decimal
+import Data.Default (def)
+import Data.Foldable (foldl')
+import Data.Ratio
 import qualified Data.Map.Strict as M
 import Data.Text (Text)
 import qualified Data.Text as Text
@@ -36,6 +33,7 @@ import Ethereum.Misc hiding (Word256)
 import Pact.Types.Runtime
 
 import Chainweb.Pact.SPV.Hyperlane.Binary
+import Chainweb.Utils.Serialization (putRawByteString, runPutS, runGetS, putWord32be, putWord256be)
 
 -- | Parses the object and evaluates Hyperlane command
 evalHyperlaneCommand :: Object Name -> ExceptT Text IO (Object Name)
@@ -67,35 +65,35 @@ verifySignatures hexMessage hexMetadata validators threshold = do
           Right s -> pure s
           Left e -> throwError $ Text.pack $ "Decoding of HyperlaneMessage failed: " ++ e
 
-  let HyperlaneMessage{..} = Binary.decode $ BL.fromStrict $ message
+  HyperlaneMessage{..} <- runGetS getHyperlaneMessage message
 
-  metadata <- case BL.fromStrict <$> decodeHex hexMetadata of
+  metadata <- case decodeHex hexMetadata of
           Right s -> pure s
           Left e -> throwError $ Text.pack $ "Decoding of Metadata failed: " ++ e
 
-  let MessageIdMultisigIsmMetadata{..} = Binary.decode metadata
+  MessageIdMultisigIsmMetadata{..} <- runGetS getMessageIdMultisigIsmMetadata metadata
 
   let
-    domainHash = getKeccak256Hash $ BL.toStrict $ Binary.runPut $ do
+    domainHash = getKeccak256Hash $ runPutS $ do
       -- Corresponds to abi.encodePacked behaviour
-      Binary.put hmOriginDomain
-      putBS mmimOriginMerkleTreeAddress
-      putBS "HYPERLANE"
+      putWord32be hmOriginDomain
+      putRawByteString mmimOriginMerkleTreeAddress
+      putRawByteString "HYPERLANE"
 
   let messageId = getKeccak256Hash message
 
   let
-    hash' = getKeccak256Hash $ BL.toStrict $ Binary.runPut $ do
+    hash' = getKeccak256Hash $ runPutS $ do
       -- Corresponds to abi.encodePacked behaviour
-      putBS domainHash
-      putBS mmimSignedCheckpointRoot
-      Binary.put mmimSignedCheckpointIndex
-      putBS messageId
+      putRawByteString domainHash
+      putRawByteString mmimSignedCheckpointRoot
+      putWord256be mmimSignedCheckpointIndex
+      putRawByteString messageId
   let
-    digest = keccak256 $ BL.toStrict $ Binary.runPut $ do
+    digest = keccak256 $ runPutS $ do
       -- Corresponds to abi.encodePacked behaviour
-      putBS ethereumHeader
-      putBS hash'
+      putRawByteString ethereumHeader
+      putRawByteString hash'
 
   addresses <- catMaybes <$> mapM (recoverHexAddress digest) mmimSignatures
 
@@ -149,16 +147,16 @@ recoverAddressValidatorAnnouncement storageLocation sig = do
           Left e -> throwError $ Text.pack $ "Decoding of domainHashHex failed: " ++ e
 
   let
-    hash' = getKeccak256Hash $ BL.toStrict $ Binary.runPut $ do
+    hash' = getKeccak256Hash $ runPutS $ do
       -- Corresponds to abi.encodePacked behaviour
-      putBS domainHash
-      putBS $ Text.encodeUtf8 storageLocation
+      putRawByteString domainHash
+      putRawByteString $ Text.encodeUtf8 storageLocation
 
   let
-    announcementDigest = keccak256 $ BL.toStrict $ Binary.runPut $ do
+    announcementDigest = keccak256 $ runPutS $ do
       -- Corresponds to abi.encodePacked behaviour
-      putBS ethereumHeader
-      putBS hash'
+      putRawByteString ethereumHeader
+      putRawByteString hash'
 
   address <- recoverHexAddress announcementDigest signatureBinary
   let addr = fmap (tStr . asString) $ address
@@ -188,10 +186,10 @@ encodeHyperlaneMessage o = do
       hmRecipient <- om ^? at "recipient" . _Just . _TLiteral . _1 . _LString . to decodeHex . _Right
 
       let hm = HyperlaneMessage{..}
-      let b = BL.toStrict $ Binary.encode hm
-      let messageId = encodeHex $ getKeccak256Hash b
-      let hex = encodeHex b
-      pure $ mkObject [ ("encodedMessage", tStr $ asString hex), ("messageId", tStr $ asString messageId) ]
+      let binaryHm = runPutS $ putHyperlaneMessage hm
+      let messageId = encodeHex $ getKeccak256Hash binaryHm
+      let hexHm = encodeHex binaryHm
+      pure $ mkObject [ ("encodedMessage", tStr $ asString hexHm), ("messageId", tStr $ asString messageId) ]
   case newObj of
     Just o' -> pure o'
     _ -> throwError "Couldn't encode HyperlaneMessage"
@@ -207,7 +205,7 @@ parseTokenMessageERC20 o = do
 encodeTokenMessageERC20 :: Object Name -> Maybe Text
 encodeTokenMessageERC20 o = do
   tm <- parseTokenMessageERC20 o
-  let hex = encodeHex $ BL.toStrict $ Binary.encode tm
+  let hex = encodeHex $ runPutS $ putTokenMessageERC20 tm
   pure hex
 
 -- | Recovers the address from keccak256 encoded digest and signature.

src/Chainweb/Pact/SPV/Hyperlane/Binary.hs

@@ -8,15 +8,12 @@
 module Chainweb.Pact.SPV.Hyperlane.Binary where
 
 import Data.ByteString as BS
-import qualified Data.ByteString.Lazy as BL
-
 import Data.DoubleWord
 import Data.Text (Text)
 import qualified Data.Text.Encoding as Text
-import Data.Binary
-import qualified Data.Binary.Builder as Builder
-import Data.Binary.Get
-import Data.Binary.Put
+import Data.Word
+
+import Chainweb.Utils.Serialization
 
 -- | Ethereum address takes 20 bytes
 ethereumAddressSize :: Int
@@ -33,27 +30,28 @@ data HyperlaneMessage = HyperlaneMessage
   }
 
 -- Corresponds to abi.encodePacked behaviour
-instance Binary HyperlaneMessage where
-  put (HyperlaneMessage {..}) = do
-    put hmVersion
-    put hmNonce
-    put hmOriginDomain
-    putBS (padLeft hmSender)
-    put hmDestinationDomain
-    putBS (padLeft hmRecipient)
-
-    put hmTokenMessage
-
-  get = do
-    hmVersion <- getWord8
-    hmNonce <- getWord32be
-    hmOriginDomain <- getWord32be
-    hmSender <- BS.takeEnd ethereumAddressSize <$> getBS 32
-    hmDestinationDomain <- getWord32be
-    hmRecipient <- BS.dropWhile (== 0) <$> getBS 32
-    hmTokenMessage <- get
-
-    return $ HyperlaneMessage {..}
+putHyperlaneMessage :: HyperlaneMessage -> Put
+putHyperlaneMessage (HyperlaneMessage {..}) = do
+  putWord8 hmVersion
+  putWord32be hmNonce
+  putWord32be hmOriginDomain
+  putRawByteString (padLeft hmSender)
+  putWord32be hmDestinationDomain
+  putRawByteString (padLeft hmRecipient)
+
+  putTokenMessageERC20 hmTokenMessage
+
+getHyperlaneMessage :: Get HyperlaneMessage
+getHyperlaneMessage = do
+  hmVersion <- getWord8
+  hmNonce <- getWord32be
+  hmOriginDomain <- getWord32be
+  hmSender <- BS.takeEnd ethereumAddressSize <$> getBS 32
+  hmDestinationDomain <- getWord32be
+  hmRecipient <- BS.dropWhile (== 0) <$> getBS 32
+  hmTokenMessage <- getTokenMessageERC20
+
+  return $ HyperlaneMessage {..}
 
 data TokenMessageERC20 = TokenMessageERC20
   { tmRecipient :: Text -- string
@@ -68,18 +66,19 @@ data TokenMessageERC20 = TokenMessageERC20
 -- 4235663664383937364600000000000000000000000000000000000000000000
 
 -- Corresponds to abi.encode behaviour
-instance Binary TokenMessageERC20 where
-  put (TokenMessageERC20 {..}) = do
-    -- the first offset is constant
-    put (64 :: Word256) -- 32 bytes
-    put tmAmount        -- 32 bytes
-    -- 64 bytes
-    put recipientSize   -- 32 bytes
-    putBS recipient     -- recipientSize
-    where
-      (recipient, recipientSize) = padRight $ Text.encodeUtf8 tmRecipient
-
-  get = do
+putTokenMessageERC20 :: TokenMessageERC20 -> Put
+putTokenMessageERC20 (TokenMessageERC20 {..}) = do
+  -- the first offset is constant
+  putWord256be (64 :: Word256) -- 32 bytes
+  putWord256be tmAmount        -- 32 bytes
+  -- 64 bytes
+  putWord256be recipientSize   -- 32 bytes
+  putRawByteString recipient   -- recipientSize
+  where
+    (recipient, recipientSize) = padRight $ Text.encodeUtf8 tmRecipient
+
+getTokenMessageERC20 :: Get TokenMessageERC20
+getTokenMessageERC20 = do
     _firstOffset <- getWord256be
     tmAmount <- getWord256be
 
@@ -104,23 +103,20 @@ data MessageIdMultisigIsmMetadata = MessageIdMultisigIsmMetadata
 -- 77c3c8d8e6029f65f7f7b0ad8b80fae2b178d14c9a7b228a539349aad0c7b58b
 -- 1b00000000000000000000000000000000000000000000000000000000000000
 
-instance Binary MessageIdMultisigIsmMetadata where
-  put = error "put instance is not implemented for MessageIdMultisigIsmMetadata"
+getMessageIdMultisigIsmMetadata :: Get MessageIdMultisigIsmMetadata
+getMessageIdMultisigIsmMetadata = do
+  mmimOriginMerkleTreeAddress <- getBS 32
+  mmimSignedCheckpointRoot <- getBS 32
+  mmimSignedCheckpointIndex <- getWord256be
+  _firstOffset <- getWord256be
 
-  -- Corresponds to abi.encode behaviour
-  get = do
-    mmimOriginMerkleTreeAddress <- getBS 32
-    mmimSignedCheckpointRoot <- getBS 32
-    mmimSignedCheckpointIndex <- getWord256be
-    _firstOffset <- getWord256be
-
-    -- we don't care about the size, we know that each signature is 65 bytes long
-    _signaturesSize <- getWord256be
+  -- we don't care about the size, we know that each signature is 65 bytes long
+  signaturesSize <- getWord256be
 
-    theRest <- BL.toStrict <$> getRemainingLazyByteString
-    let mmimSignatures = sliceSignatures theRest
+  signaturesBytes <- getByteString (fromIntegral signaturesSize)
+  let mmimSignatures = sliceSignatures signaturesBytes
 
-    return $ MessageIdMultisigIsmMetadata{..}
+  return $ MessageIdMultisigIsmMetadata{..}
 
 -- | Pad with zeroes on the left to 32 bytes
 --
@@ -144,46 +140,10 @@ padRight s =
 restSize :: Integral a => a -> a
 restSize size = (32 - size) `mod` 32
 
--- | Puts bytestring without size using 'Builder'.
-putBS :: ByteString -> Put
-putBS s = putBuilder $ Builder.fromByteString s
-
 -- | Reads a given number of bytes and the rest because binary data padded up to 32 bytes.
 getBS :: Word256 -> Get BS.ByteString
 getBS size = (BS.take (fromIntegral size)) <$> getByteString (fromIntegral $ size + restSize size)
 
-instance Binary Word128 where
-  put (Word128 w1 w2) = do
-    putWord64be w1
-    putWord64be w2
-
-  get = do
-    w1 <- getWord64be
-    w2 <- getWord64be
-    pure $ Word128 w1 w2
-
-putWord128be :: Word128 -> Put
-putWord128be = put
-
-getWord128be :: Get Word128
-getWord128be = get
-
-instance Binary Word256 where
-  put (Word256 w1 w2) = do
-    putWord128be w1
-    putWord128be w2
-
-  get = do
-    w1 <- getWord128be
-    w2 <- getWord128be
-    pure $ Word256 w1 w2
-
-putWord256be :: Word256 -> Put
-putWord256be = put
-
-getWord256be :: Get Word256
-getWord256be = get
-
 -- | Signatures are 65 bytes sized, we split the bytestring by 65 symbols segments.
 sliceSignatures :: ByteString -> [ByteString]
 sliceSignatures sig' = go sig' []

src/Chainweb/Utils/Serialization.hs

@@ -31,8 +31,13 @@ module Chainweb.Utils.Serialization
     , getWord64le
     , putWord64be
     , getWord64be
+    , putWord128be
+    , getWord128be
+    , putWord256be
+    , getWord256be
     , putByteString
     , getByteString
+    , putRawByteString
 
     -- abstract encoders and decoders
     , WordEncoding(..)
@@ -57,6 +62,7 @@ import qualified Data.Text as T
 import Data.Word
 
 import qualified Data.Binary as Binary
+import qualified Data.Binary.Builder as Builder
 import qualified Data.Binary.Get as Binary
 import qualified Data.Binary.Put as Binary
 
@@ -147,6 +153,22 @@ getByteString = coerce Binary.getByteString
 putByteString :: B.ByteString -> Put
 putByteString = coerce Binary.putByteString
 
+putWord128be :: Word128 -> Put
+putWord128be = encodeWordBe
+
+getWord128be :: Get Word128
+getWord128be = decodeWordBe
+
+putWord256be :: Word256 -> Put
+putWord256be = encodeWordBe
+
+getWord256be :: Get Word256
+getWord256be = decodeWordBe
+
+-- | Puts bytestring without size using 'Builder'.
+putRawByteString :: B.ByteString -> Put
+putRawByteString = coerce (Binary.putBuilder . Builder.fromByteString)
+
 --------------------
 -- Abstract encoders/decoders
 --------------------

test/Chainweb/Test/Pact/SPV/Hyperlane.hs

@@ -16,8 +16,6 @@ module Chainweb.Test.Pact.SPV.Hyperlane
 ) where
 
 import Control.Monad.Trans.Except
-import qualified Data.ByteString.Lazy as BL
-import qualified Data.Binary as Binary
 import Data.Text (Text)
 
 import Test.Tasty
@@ -33,6 +31,7 @@ import Pact.Types.Util (AsString(..))
 
 import Chainweb.Pact.SPV.Hyperlane
 import Chainweb.Pact.SPV.Hyperlane.Binary
+import Chainweb.Utils.Serialization (runGetS)
 
 tests :: TestTree
 tests = testGroup "hyperlane"
@@ -73,8 +72,8 @@ hyperlaneDecodeTokenMessageERC20 = do
   encodedBinary <- case decodeHex encodedMessage of
       Right r -> pure r
       Left _ -> assertFailure "hyperlaneDecodeTokenMessageERC20: failed to decode"
+  tm <- runGetS getTokenMessageERC20 encodedBinary
   let
-    tm = Binary.decode $ BL.fromStrict encodedBinary
     expectedObject = TokenMessageERC20 "recipient" 3333333333333333333
   assertEqual "Should properly decode the object" expectedObject tm