From abdfc2a5bbf343640a69e23bcf9d54e171975b90 Mon Sep 17 00:00:00 2001 From: Jin Chui Date: Fri, 31 Oct 2025 17:01:28 +1100 Subject: [PATCH 1/3] Implement EIP712Signature module It expose the following: * Data types specific for EIP712 * signTypeData and signTypedData' for signing EIP712 data structures * typedDataSignHash create the hash that needs to be signed for an EIP712 data structure * encodeData, encodeType, hashStruct are exposed as intermediary functions for testing purpose --- packages/crypto/package.yaml | 2 + .../src/Crypto/Ethereum/Eip712Signature.hs | 382 ++++++++++++++++++ .../Ethereum/Test/EIP712SignatureSpec.hs | 210 ++++++++++ packages/crypto/web3-crypto.cabal | 9 +- 4 files changed, 602 insertions(+), 1 deletion(-) create mode 100644 packages/crypto/src/Crypto/Ethereum/Eip712Signature.hs create mode 100644 packages/crypto/tests/Crypto/Ethereum/Test/EIP712SignatureSpec.hs diff --git a/packages/crypto/package.yaml b/packages/crypto/package.yaml index 8901b5d2..1e958392 100644 --- a/packages/crypto/package.yaml +++ b/packages/crypto/package.yaml @@ -25,6 +25,8 @@ dependencies: - crypton >0.30 && <1.0 - bytestring >0.10 && <0.12 - memory-hexstring >=1.0 && <1.1 +- basement >=0.0.16 && < 0.1 +- scientific >=0.3.7 && < 0.4 ghc-options: - -funbox-strict-fields diff --git a/packages/crypto/src/Crypto/Ethereum/Eip712Signature.hs b/packages/crypto/src/Crypto/Ethereum/Eip712Signature.hs new file mode 100644 index 00000000..294cbe52 --- /dev/null +++ b/packages/crypto/src/Crypto/Ethereum/Eip712Signature.hs @@ -0,0 +1,382 @@ +{-# LANGUAGE ImpredicativeTypes #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeApplications #-} + +module Crypto.Ethereum.Eip712Signature + ( EIP712Name + , BitWidth (..) + , ByteWidth (..) + , HasWidth (..) + , EIP712FieldType (..) + , EIP712TypedData (..) + , EIP712Struct (..) + , EIP712Field (..) + , EIP712Types + , signTypedData + , signTypedData' + , hashStruct + , encodeType + , encodeData + , typedDataSignHash + ) +where + +import Basement.Types.Word256 (Word256(..)) +import Control.Monad (when) +import Crypto.Ecdsa.Signature (pack, sign) +import Crypto.Ethereum (PrivateKey, keccak256) +import Data.Aeson (Object, (.=)) +import qualified Data.Aeson as Aeson +import Data.Aeson.Key (fromText) +import qualified Data.Aeson.KeyMap as Aeson +import Data.Aeson.Types (object) +import Data.ByteArray (ByteArray, zero) +import qualified Data.ByteArray as BA +import Data.ByteArray.HexString (hexString) +import Data.ByteString (ByteString, toStrict) +import qualified Data.ByteString as BS +import Data.ByteString.Builder (toLazyByteString, word64BE) +import Data.Either (partitionEithers) +import Data.Foldable (toList) +import Data.List (find, intercalate) +import Data.Maybe (mapMaybe) +import Data.Scientific (Scientific, floatingOrInteger) +import Data.Set (Set) +import qualified Data.Set as Set +import Data.String (fromString) +import Data.Text (Text) +import qualified Data.Text as T +import Data.Text.Encoding (encodeUtf8) +import qualified Data.Text.Encoding as TE +import Data.Word (Word8) +import Numeric.Natural (Natural) + +type DefaultByteArray = ByteString + +-- Bit and Byte width constants, used for defining field types + +data BitWidth + = Si8 + | Si16 + | Si24 + | Si32 + | Si40 + | Si48 + | Si56 + | Si64 + | Si72 + | Si80 + | Si88 + | Si96 + | Si104 + | Si112 + | Si120 + | Si128 + | Si136 + | Si144 + | Si152 + | Si160 + | Si168 + | Si176 + | Si184 + | Si192 + | Si200 + | Si208 + | Si216 + | Si224 + | Si232 + | Si240 + | Si248 + | Si256 + deriving (Show, Eq, Bounded, Enum) + +data ByteWidth + = S1 + | S2 + | S3 + | S4 + | S5 + | S6 + | S7 + | S8 + | S9 + | S10 + | S11 + | S12 + | S13 + | S14 + | S15 + | S16 + | S17 + | S18 + | S19 + | S20 + | S21 + | S22 + | S23 + | S24 + | S25 + | S26 + | S27 + | S28 + | S29 + | S30 + | S31 + | S32 + deriving (Show, Eq, Bounded, Enum) + +class HasWidth a where + bytesOf :: a -> Int + +instance HasWidth ByteWidth where + bytesOf a = fromEnum a + 1 + +instance HasWidth BitWidth where + bytesOf a = fromEnum a + 1 + +bitsOf :: (HasWidth a) => a -> Int +bitsOf a = bytesOf a * 8 + +-- EIP712 Data structures + +type EIP712Name = Text + +data EIP712FieldType + = FieldTypeBytesN ByteWidth + | FieldTypeUInt BitWidth + | FieldTypeInt BitWidth + | FieldTypeBool + | FieldTypeAddress + | FieldTypeBytes + | FieldTypeString + | FieldTypeArrayN Natural EIP712FieldType + | FieldTypeArray EIP712FieldType + | FieldTypeStruct EIP712Name + deriving (Show, Eq) + +data EIP712Field = EIP712Field + { eip712FieldName :: EIP712Name + , eip712FieldType :: EIP712FieldType + } + deriving (Show, Eq) + +data EIP712Struct = EIP712Struct + { eip712StructName :: EIP712Name + , eip712StructFields :: [EIP712Field] + } + deriving (Show, Eq) + +type EIP712Types = [EIP712Struct] + +data EIP712TypedData + = EIP712TypedData + { typedDataTypes :: EIP712Types + , typedDataPrimaryType :: EIP712Name + , typedDataDomain :: Object + , typedDataMessage :: Object + } + deriving (Show) + +-- ToJSON serialization + +instance Aeson.ToJSON EIP712Field where + toJSON field = object ["name" .= eip712FieldName field, "type" .= TE.decodeUtf8 (encode $ eip712FieldType field)] + +instance Aeson.ToJSON EIP712TypedData where + toJSON typedData = + object + [ "types" + .= object + [ fromText (eip712StructName s) .= eip712StructFields s + | s <- typedDataTypes typedData + ] + , "primaryType" .= typedDataPrimaryType typedData + , "domain" .= typedDataDomain typedData + , "message" .= typedDataMessage typedData + ] + +-- Custom EIP712 encoding + +class EIP712Encoded a where + encode :: (ByteArray bout) => a -> bout -- TODO Check if using ByteArray is better + +instance EIP712Encoded EIP712FieldType where + encode = \case + FieldTypeBytesN sb -> utf8 "bytes" <> toByteArray (bytesOf sb) + FieldTypeUInt sb -> utf8 "uint" <> toByteArray (bitsOf sb) + FieldTypeInt sb -> utf8 "int" <> toByteArray (bitsOf sb) + FieldTypeBool -> utf8 "bool" + FieldTypeAddress -> utf8 "address" + FieldTypeBytes -> utf8 "bytes" + FieldTypeString -> utf8 "string" + FieldTypeArrayN n t -> encode t <> utf8 "[" <> toByteArray n <> utf8 "]" + FieldTypeArray t -> encode t <> utf8 "[]" + FieldTypeStruct name -> utf8 name + +instance EIP712Encoded EIP712Field where + encode EIP712Field{..} = encode eip712FieldType <> utf8 " " <> utf8 eip712FieldName + +-- | Encode a type according to the EIP712 specification (see Definition of `encodeType`) +encodeType :: (ByteArray bout) => EIP712Types -> EIP712Name -> Either String bout +encodeType types typeName = do + struct <- lookupType types typeName + refs <- referencedTypesEncoded struct + let base = encodeUtf8 typeName <> "(" <> fieldsEncoded struct <> ")" + pure $ BA.convert $ base <> refs + where + fieldsEncoded :: EIP712Struct -> BS.ByteString + fieldsEncoded = BS.intercalate "," . fmap encode . eip712StructFields + + referencedTypesEncoded :: EIP712Struct -> Either String ByteString + referencedTypesEncoded = + fmap (BS.concat . toList) + . traverse (encodeType types) + . Set.toList + . referencedTypesNames + + referencedTypesNames :: EIP712Struct -> Set EIP712Name + referencedTypesNames = Set.fromList . mapMaybe (maybeReferenceTypeName . eip712FieldType) . eip712StructFields + + maybeReferenceTypeName :: EIP712FieldType -> Maybe EIP712Name + maybeReferenceTypeName = \case + FieldTypeArray inner -> maybeReferenceTypeName inner + FieldTypeArrayN _ inner -> maybeReferenceTypeName inner + FieldTypeStruct name -> Just name + _ -> Nothing + +-- | Encode data according to the EIP712 specification (see Definition of `encodeData`) +encodeData :: (ByteArray bout) => EIP712Types -> EIP712Name -> Aeson.Object -> Either String bout +encodeData types typeName obj = do + encodedFields <- fieldsAndValues >>= mapM (uncurry encodeValue) + return $ BA.concat encodedFields + where + findValue :: Text -> Either String Aeson.Value + findValue fieldName = case Aeson.lookup (fromString $ T.unpack fieldName) obj of + Just v -> Right v + Nothing -> Left $ fromString $ T.unpack fieldName + + fieldsAndValues :: Either String [(EIP712FieldType, Aeson.Value)] + fieldsAndValues = do + fields <- eip712StructFields <$> lookupType types typeName + let valueOrFieldNameList = fmap (findValue . eip712FieldName) fields + let (missingFields, values) = partitionEithers valueOrFieldNameList + if (not . null) missingFields + then Left $ "missing fields" <> intercalate ", " missingFields + else Right $ zip (fmap eip712FieldType fields) values + + encodeValue :: EIP712FieldType -> Aeson.Value -> Either String BA.Bytes + encodeValue (FieldTypeBytesN s) v = do + encodedBytes <- extractString v >>= hexString . encodeUtf8 + when (BA.length encodedBytes /= bytesOf s) $ Left $ "expected" <> show (bytesOf s) <> "bytes, got " <> show (BA.length encodedBytes) + return $ BA.convert encodedBytes <> zero (32 - bytesOf s) + encodeValue (FieldTypeUInt _) v = do + value <- extractNumber v >>= scientificToWord256 + when (value < 0) $ Left $ "expected unsigned int, got negative value " <> show value + return $ encodeWord256 value + encodeValue (FieldTypeInt _) v = encodeWord256 <$> (extractNumber v >>= scientificToWord256) + encodeValue FieldTypeBool v = encodeWord256 . fromIntegral . fromEnum <$> extractBool v + encodeValue FieldTypeAddress v = do + valueAsHexString <- extractString v >>= hexString . encodeUtf8 + when (BA.length valueAsHexString /= 20) $ Left ("address not valid:" <> show v) + return $ BA.convert $ zero 12 <> valueAsHexString + encodeValue FieldTypeBytes v = do + valueAsHexString <- extractString v >>= hexString . encodeUtf8 + return $ keccak256 valueAsHexString + encodeValue FieldTypeString v = keccak256 . encodeUtf8 <$> extractString v + encodeValue (FieldTypeArrayN _ innerType) v = encodeArray innerType v + encodeValue (FieldTypeArray innerType) v = encodeArray innerType v + encodeValue (FieldTypeStruct innerTypeName) v = do + valueAsObject <- extractObject v + hashStruct types innerTypeName valueAsObject + + encodeArray innerType v = do + valueAsArray <- extractArray v + encodedValues <- traverse (encodeValue innerType) valueAsArray + return $ keccak256 $ BA.concat @BA.Bytes @BA.Bytes $ toList encodedValues + + encodeWord256 (Word256 a3 a2 a1 a0) = BA.convert $ toStrict $ toLazyByteString $ word64BE a3 <> word64BE a2 <> word64BE a1 <> word64BE a0 + + +-- | Compute a hash for the struct according to EIP712 (see Definition of `hashStruct`) +hashStruct :: (ByteArray bout) => EIP712Types -> EIP712Name -> Aeson.Object -> Either String bout +hashStruct types typeName obj = do + encodedData <- encodeData @DefaultByteArray types typeName obj + encodedType <- encodeType @DefaultByteArray types typeName + let typeHash = keccak256 encodedType + return $ keccak256 $ typeHash <> encodedData + +-- | Sign a EIP712 type data, returns encoded version of the signature +signTypedData :: (ByteArray rsv) => PrivateKey -> EIP712TypedData -> Either String rsv +signTypedData key typedData = pack <$> signTypedData' key typedData + +-- | Sign a EIP712 type data, returns (r, s, v) +signTypedData' :: PrivateKey -> EIP712TypedData -> Either String (Integer, Integer, Word8) +signTypedData' key typedData = sign @DefaultByteArray key <$> typedDataSignHash typedData + +-- | Returns the hash that needs to be signed by the private key +typedDataSignHash :: (ByteArray bout) => EIP712TypedData -> Either String bout +typedDataSignHash typedData = do + domainSeparator <- hashStruct (typedDataTypes typedData) "EIP712Domain" (typedDataDomain typedData) + hashStructMessage <- hashStruct (typedDataTypes typedData) (typedDataPrimaryType typedData) (typedDataMessage typedData) + return $ keccak256 @DefaultByteArray (BA.pack [0x19, 0x01] <> domainSeparator <> hashStructMessage) + +-------------------------------------------------------------------------------------------------------- +-- Utility functions for data manipulation +-------------------------------------------------------------------------------------------------------- + +lookupType :: EIP712Types -> EIP712Name -> Either String EIP712Struct +lookupType types typeName = + case find ((== typeName) . eip712StructName) types of + Just struct -> Right struct + Nothing -> + Left $ "EIP712 type not found: " <> show typeName + +describeJsonType :: Aeson.Value -> String +describeJsonType (Aeson.String _) = "string" +describeJsonType (Aeson.Number _) = "number" +describeJsonType (Aeson.Bool _) = "boolean" +describeJsonType (Aeson.Array _) = "array" +describeJsonType (Aeson.Object _) = "object" +describeJsonType Aeson.Null = "null" + +extractError :: String -> Aeson.Value -> Either String b +extractError expected v = Left $ "expected " <> expected <> ", got " <> describeJsonType v + +extractString :: Aeson.Value -> Either String Text +extractString (Aeson.String v) = Right v +extractString v = extractError "string" v + +extractNumber :: Aeson.Value -> Either String Scientific +extractNumber (Aeson.Number v) = Right v +extractNumber v = extractError "number" v + +extractBool :: Aeson.Value -> Either String Bool +extractBool (Aeson.Bool v) = Right v +extractBool v = extractError "bool" v + +extractArray :: Aeson.Value -> Either String Aeson.Array +extractArray (Aeson.Array v) = Right v +extractArray v = extractError "array" v + +extractObject :: Aeson.Value -> Either String Aeson.Object +extractObject (Aeson.Object v) = Right v +extractObject v = extractError "object" v + +scientificToWord256 :: Scientific -> Either String Word256 +scientificToWord256 n = case floatingOrInteger @Double n of + Right r -> Right $ fromInteger r + Left r -> Left $ "Number is not an integer: " <> show r + +-------------------------------------------------------------------------------------------------------- +-- Utility functions for encoding +-------------------------------------------------------------------------------------------------------- + +-- | Generic "to UTF8 bytes" helper +utf8 :: (BA.ByteArray b) => T.Text -> b +utf8 = BA.convert . TE.encodeUtf8 + +-- | Convert a Show-able value to UTF8 bytes +toByteArray :: (Show a, BA.ByteArray b) => a -> b +toByteArray = utf8 . T.pack . show diff --git a/packages/crypto/tests/Crypto/Ethereum/Test/EIP712SignatureSpec.hs b/packages/crypto/tests/Crypto/Ethereum/Test/EIP712SignatureSpec.hs new file mode 100644 index 00000000..b0a2a94d --- /dev/null +++ b/packages/crypto/tests/Crypto/Ethereum/Test/EIP712SignatureSpec.hs @@ -0,0 +1,210 @@ +{-# LANGUAGE ImpredicativeTypes #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} + +module Crypto.Ethereum.Test.EIP712SignatureSpec (spec) where + +import Crypto.Ethereum.Eip712Signature +import Crypto.Ethereum.Utils (keccak256) +import Data.Aeson (toJSON) +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.KeyMap as Aeson +import qualified Data.ByteArray.Encoding as BAE +import Data.ByteString (ByteString) +import Data.Either (fromRight) +import Test.Hspec + +encodeTypeConcrete :: EIP712Types -> EIP712Name -> Either String ByteString +encodeTypeConcrete = encodeType + +keccak256Concrete :: ByteString -> ByteString +keccak256Concrete = keccak256 + +hexEncode :: ByteString -> ByteString +hexEncode = BAE.convertToBase BAE.Base16 + +encodeDataConcrete :: EIP712Types -> EIP712Name -> Aeson.Object -> Either String ByteString +encodeDataConcrete = encodeData + +hashStructConcrete :: EIP712Types -> EIP712Name -> Aeson.Object -> Either String ByteString +hashStructConcrete = hashStruct + +mailTypes :: EIP712Types +mailTypes = + [ EIP712Struct + { eip712StructName = "Mail" + , eip712StructFields = + [ EIP712Field "from" (FieldTypeStruct "Person") + , EIP712Field "to" (FieldTypeStruct "Person") + , EIP712Field "contents" FieldTypeString + ] + } + , EIP712Struct + { eip712StructName = "Person" + , eip712StructFields = + [ EIP712Field "name" FieldTypeString + , EIP712Field "wallet" FieldTypeAddress + ] + } + , EIP712Struct + { eip712StructName = "EIP712Domain" + , eip712StructFields = + [ EIP712Field "name" FieldTypeString + , EIP712Field "version" FieldTypeString + , EIP712Field "chainId" (FieldTypeUInt Si256) + , EIP712Field "verifyingContract" FieldTypeAddress + ] + } + ] + +nestedArrayTypes :: EIP712Types +nestedArrayTypes = + [ EIP712Struct + { eip712StructName = "foo" + , eip712StructFields = + [ EIP712Field "a" (FieldTypeArray (FieldTypeArray (FieldTypeUInt Si256))) + , EIP712Field "b" FieldTypeString + ] + } + ] + +safeTxType :: EIP712Struct +safeTxType = + EIP712Struct + { eip712StructName = "SafeTx" + , eip712StructFields = + [ EIP712Field "to" FieldTypeAddress + , EIP712Field "value" (FieldTypeUInt Si256) + , EIP712Field "data" FieldTypeBytes + , EIP712Field "operation" (FieldTypeUInt Si8) + , EIP712Field "safeTxGas" (FieldTypeUInt Si256) + , EIP712Field "baseGas" (FieldTypeUInt Si256) + , EIP712Field "gasPrice" (FieldTypeUInt Si256) + , EIP712Field "gasToken" FieldTypeAddress + , EIP712Field "refundReceiver" FieldTypeAddress + , EIP712Field "nonce" (FieldTypeUInt Si256) + ] + } + +expectedEncodedSafeTxType :: ByteString +expectedEncodedSafeTxType = "SafeTx(\ + \address to,\ + \uint256 value,\ + \bytes data,\ + \uint8 operation,\ + \uint256 safeTxGas,\ + \uint256 baseGas,\ + \uint256 gasPrice,\ + \address gasToken,\ + \address refundReceiver,\ + \uint256 nonce)" + +safeDomainType :: EIP712Struct +safeDomainType = + EIP712Struct + { eip712StructName = "EIP712Domain" + , eip712StructFields = + [ EIP712Field "chainId" (FieldTypeUInt Si256) + , EIP712Field "verifyingContract" FieldTypeAddress + ] + } + +safeDomain :: Aeson.KeyMap Aeson.Value +safeDomain = + Aeson.fromList + [("chainId", toJSON @Int 8453), ("verifyingContract", toJSON @String "0xCD2a3d9F938E13CD947Ec05AbC7FE734Df8DD826")] + +expectedEncodedSafeDomain :: ByteString +expectedEncodedSafeDomain = "0000000000000000000000000000000000000000000000000000000000002105\ + \000000000000000000000000cd2a3d9f938e13cd947ec05abc7fe734df8dd826" + +safeMessage :: Aeson.KeyMap Aeson.Value +safeMessage = + Aeson.fromList + [ ("to",toJSON @String "0xaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" ) + , ("value", toJSON @Integer 0 ) + , ("data", toJSON @String "0x0b89085a01a3b67d2231c6a136f9c8eea75d7d479a83a127356f8540ee15af010c22b846886e98aeffc1f1166d4b3586") + , ("operation", toJSON @Integer 0) + , ("safeTxGas", toJSON @Integer 0) + , ("baseGas", toJSON @Integer 0) + , ("gasPrice", toJSON @Integer 0) + , ("gasToken", toJSON @String "0x0000000000000000000000000000000000000000") + , ("refundReceiver", toJSON @String "0x0000000000000000000000000000000000000000") + , ("nonce", toJSON (37 :: Integer)) + ] + +expectedEncodedSafeMessage :: ByteString +expectedEncodedSafeMessage = "000000000000000000000000aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\ + \0000000000000000000000000000000000000000000000000000000000000000\ + \059c15417e7e213ad30596d872d2e906e4feafd54fa0c9ac864b421ab1ba5adb\ + \0000000000000000000000000000000000000000000000000000000000000000\ + \0000000000000000000000000000000000000000000000000000000000000000\ + \0000000000000000000000000000000000000000000000000000000000000000\ + \0000000000000000000000000000000000000000000000000000000000000000\ + \0000000000000000000000000000000000000000000000000000000000000000\ + \0000000000000000000000000000000000000000000000000000000000000000\ + \0000000000000000000000000000000000000000000000000000000000000025" + +safeTxTypedData :: EIP712TypedData +safeTxTypedData = EIP712TypedData + { typedDataTypes = [safeTxType, safeDomainType] + , typedDataPrimaryType = "SafeTx" + , typedDataDomain = safeDomain + , typedDataMessage = safeMessage + } + + +spec :: Spec +spec = do + describe "encodeType" $ do + it "simple types should be encoding properly" $ do + let eip712structs = mailTypes + encodeTypeConcrete eip712structs "Person" `shouldBe` Right "Person(string name,address wallet)" + encodeTypeConcrete eip712structs "Mail" + `shouldBe` Right "Mail(Person from,Person to,string contents)Person(string name,address wallet)" + encodeTypeConcrete eip712structs "EIP712Domain" + `shouldBe` Right "EIP712Domain(string name,string version,uint256 chainId,address verifyingContract)" + it "should work for Safe transactions" $ do + + encodeTypeConcrete [safeDomainType] "EIP712Domain" `shouldBe` Right "EIP712Domain(uint256 chainId,address verifyingContract)" + hexEncode . keccak256Concrete <$> encodeTypeConcrete [safeDomainType] "EIP712Domain" + `shouldBe` Right "47e79534a245952e8b16893a336b85a3d9ea9fa8c573f3d803afb92a79469218" + hexEncode <$> hashStruct [safeDomainType] "EIP712Domain" safeDomain + `shouldBe` Right "b3a3e869527602e68d877d9edcc629823648c73a3b10ee1e23cf4ab81b599cf5" + + it "should work for safe transaction" $ encodeTypeConcrete [safeTxType] "SafeTx" + `shouldBe` Right expectedEncodedSafeTxType + + describe "encodeData" $ do + it "should encode simple data" $ do + let eip712structs = mailTypes + let typeName = "Person" + let message = + Aeson.fromList + [("name", toJSON ("Cow" :: String)), ("wallet", toJSON ("0xCD2a3d9F938E13CD947Ec05AbC7FE734Df8DD826" :: String))] + let encodedDataOrError = encodeDataConcrete eip712structs typeName message + let expectedEncodedData = "8c1d2bd5348394761719da11ec67eedae9502d137e8940fee8ecd6f641ee1648\ + \000000000000000000000000cd2a3d9f938e13cd947ec05abc7fe734df8dd826" + hexEncode <$> encodedDataOrError `shouldBe` Right expectedEncodedData + hashStructConcrete eip712structs "Person" message + `shouldBe` Right (keccak256Concrete $ keccak256Concrete "Person(string name,address wallet)" <> fromRight undefined encodedDataOrError) + + it "should encode nested arrays" $ do + let message = + Aeson.fromList + [ ("a", toJSON [[35 :: Int, 36], [37]]) + , ("b", toJSON ("hello" :: String)) + ] + encodeTypeConcrete nestedArrayTypes "foo" `shouldBe` Right "foo(uint256[][] a,string b)" + let expectedDataEncoded = "fa5ffe3a0504d850bc7c9eeda1cf960b596b73f4dc0272a6fa89dace08e32029\ + \1c8aff950685c2ed4bc3174f3472287b56d9517b9c948127319a09a7a36deac8" + hexEncode <$> encodeDataConcrete nestedArrayTypes "foo" message `shouldBe` Right expectedDataEncoded + it "should encode Safe domain" $ + (hexEncode <$> encodeDataConcrete [safeDomainType] "EIP712Domain" safeDomain) `shouldBe` Right expectedEncodedSafeDomain + + it "should encode Safe transaction" $ + (hexEncode <$> encodeDataConcrete [safeTxType] "SafeTx" safeMessage) `shouldBe` Right expectedEncodedSafeMessage + + + describe "typedDataSignHash" $ it "encode properly a safe transaction" $ do + hexEncode <$> typedDataSignHash safeTxTypedData `shouldBe` Right "cd3b59061dd8a7060486fb14e75e2f066a19a6e93f6888dbf83c77fbfeb8874b" diff --git a/packages/crypto/web3-crypto.cabal b/packages/crypto/web3-crypto.cabal index 3262e9d4..81f1e608 100644 --- a/packages/crypto/web3-crypto.cabal +++ b/packages/crypto/web3-crypto.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.37.0. +-- This file has been generated from package.yaml by hpack version 0.38.1. -- -- see: https://github.com/sol/hpack @@ -31,6 +31,7 @@ library Crypto.Ecdsa.Signature Crypto.Ecdsa.Utils Crypto.Ethereum + Crypto.Ethereum.Eip712Signature Crypto.Ethereum.Keyfile Crypto.Ethereum.Signature Crypto.Ethereum.Utils @@ -49,11 +50,13 @@ library build-depends: aeson >1.2 && <2.2 , base >4.11 && <4.19 + , basement >=0.0.16 && <0.1 , bytestring >0.10 && <0.12 , containers >0.6 && <0.7 , crypton >0.30 && <1.0 , memory >0.14 && <0.19 , memory-hexstring ==1.0.* + , scientific >=0.3.7 && <0.4 , text >1.2 && <2.1 , uuid-types >1.0 && <1.1 , vector >0.12 && <0.14 @@ -63,6 +66,7 @@ test-suite tests type: exitcode-stdio-1.0 main-is: Spec.hs other-modules: + Crypto.Ethereum.Test.EIP712SignatureSpec Crypto.Ethereum.Test.KeyfileSpec Crypto.Ethereum.Test.SignatureSpec Crypto.Random.Test.HmacDrbgSpec @@ -72,6 +76,7 @@ test-suite tests Crypto.Ecdsa.Signature Crypto.Ecdsa.Utils Crypto.Ethereum + Crypto.Ethereum.Eip712Signature Crypto.Ethereum.Keyfile Crypto.Ethereum.Signature Crypto.Ethereum.Utils @@ -90,6 +95,7 @@ test-suite tests build-depends: aeson >1.2 && <2.2 , base >4.11 && <4.19 + , basement >=0.0.16 && <0.1 , bytestring >0.10 && <0.12 , containers >0.6 && <0.7 , crypton >0.30 && <1.0 @@ -99,6 +105,7 @@ test-suite tests , hspec-expectations >=0.8.2 && <0.9 , memory >0.14 && <0.19 , memory-hexstring ==1.0.* + , scientific >=0.3.7 && <0.4 , text >1.2 && <2.1 , uuid-types >1.0 && <1.1 , vector >0.12 && <0.14 From f15aa8b77fbab993b814f6d53da190c65ba9f163 Mon Sep 17 00:00:00 2001 From: Aleksandr Krupenkin Date: Sat, 22 Nov 2025 16:38:06 +0300 Subject: [PATCH 2/3] Update Eip712Signature.hs Co-authored-by: Copilot <175728472+Copilot@users.noreply.github.com> --- packages/crypto/src/Crypto/Ethereum/Eip712Signature.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/packages/crypto/src/Crypto/Ethereum/Eip712Signature.hs b/packages/crypto/src/Crypto/Ethereum/Eip712Signature.hs index 294cbe52..e17efefc 100644 --- a/packages/crypto/src/Crypto/Ethereum/Eip712Signature.hs +++ b/packages/crypto/src/Crypto/Ethereum/Eip712Signature.hs @@ -269,7 +269,7 @@ encodeData types typeName obj = do encodeValue :: EIP712FieldType -> Aeson.Value -> Either String BA.Bytes encodeValue (FieldTypeBytesN s) v = do encodedBytes <- extractString v >>= hexString . encodeUtf8 - when (BA.length encodedBytes /= bytesOf s) $ Left $ "expected" <> show (bytesOf s) <> "bytes, got " <> show (BA.length encodedBytes) + when (BA.length encodedBytes /= bytesOf s) $ Left $ "expected " <> show (bytesOf s) <> "bytes, got " <> show (BA.length encodedBytes) return $ BA.convert encodedBytes <> zero (32 - bytesOf s) encodeValue (FieldTypeUInt _) v = do value <- extractNumber v >>= scientificToWord256 From ba9eb05db174c4a94405e345387494733d3bad02 Mon Sep 17 00:00:00 2001 From: Jin Chui Date: Thu, 27 Nov 2025 17:10:14 +1100 Subject: [PATCH 3/3] Add header and remove old TODO --- .../crypto/src/Crypto/Ethereum/Eip712Signature.hs | 15 ++++++++++++++- .../Crypto/Ethereum/Test/EIP712SignatureSpec.hs | 10 ++++++++++ 2 files changed, 24 insertions(+), 1 deletion(-) diff --git a/packages/crypto/src/Crypto/Ethereum/Eip712Signature.hs b/packages/crypto/src/Crypto/Ethereum/Eip712Signature.hs index e17efefc..3a53808b 100644 --- a/packages/crypto/src/Crypto/Ethereum/Eip712Signature.hs +++ b/packages/crypto/src/Crypto/Ethereum/Eip712Signature.hs @@ -4,6 +4,19 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeApplications #-} +-- | +-- Module : Crypto.Ethereum.Eip712Signature +-- Copyright : Jin Chui 2025 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me jinchui@pm.me +-- Stability : experimental +-- Portability : portable +-- +-- Ethereum EIP712 Singature implementation. +-- Spec https://eips.ethereum.org/EIPS/eip-712. +-- + module Crypto.Ethereum.Eip712Signature ( EIP712Name , BitWidth (..) @@ -200,7 +213,7 @@ instance Aeson.ToJSON EIP712TypedData where -- Custom EIP712 encoding class EIP712Encoded a where - encode :: (ByteArray bout) => a -> bout -- TODO Check if using ByteArray is better + encode :: (ByteArray bout) => a -> bout instance EIP712Encoded EIP712FieldType where encode = \case diff --git a/packages/crypto/tests/Crypto/Ethereum/Test/EIP712SignatureSpec.hs b/packages/crypto/tests/Crypto/Ethereum/Test/EIP712SignatureSpec.hs index b0a2a94d..cead1dc4 100644 --- a/packages/crypto/tests/Crypto/Ethereum/Test/EIP712SignatureSpec.hs +++ b/packages/crypto/tests/Crypto/Ethereum/Test/EIP712SignatureSpec.hs @@ -2,6 +2,16 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} +-- | +-- Module : Crypto.Ethereum.Test.EIP712SignatureSpec +-- Copyright : Jin Chui 2025 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me jinchui@pm.me +-- Stability : experimental +-- Portability : unportable +-- + module Crypto.Ethereum.Test.EIP712SignatureSpec (spec) where import Crypto.Ethereum.Eip712Signature