diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -186,7 +186,7 @@ same "printed page" as the copyright notice for easier identification within third-party archives. -Copyright 2016-2021 Aleksandr Krupenkin +Copyright 2016-2026 Aleksandr Krupenkin Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. diff --git a/src/Crypto/Ecdsa/Signature.hs b/src/Crypto/Ecdsa/Signature.hs --- a/src/Crypto/Ecdsa/Signature.hs +++ b/src/Crypto/Ecdsa/Signature.hs @@ -34,7 +34,7 @@ import Data.ByteArray (ByteArray, ByteArrayAccess, Bytes, convert, singleton, takeView, view) -import qualified Data.ByteArray as BA (unpack) +import qualified Data.ByteArray as BA (length, replicate, unpack) import Data.Word (Word8) import Crypto.Ecdsa.Utils (exportKey) @@ -93,4 +93,11 @@ -- | Pack recoverable signature as byte array (65 byte length). pack :: ByteArray rsv => (Integer, Integer, Word8) -> rsv -pack (r, s, v) = i2osp r <> i2osp s <> singleton v +pack (r, s, v) = leftPad 32 (i2osp r) <> leftPad 32 (i2osp s) <> singleton v + where + leftPad :: (ByteArray b) => Int -> b -> b + leftPad targetLen bs + | BA.length bs >= targetLen = bs + | otherwise = BA.replicate paddingLen 0 <> bs + where + paddingLen = targetLen - BA.length bs diff --git a/src/Crypto/Ethereum/Eip712Signature.hs b/src/Crypto/Ethereum/Eip712Signature.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Ethereum/Eip712Signature.hs @@ -0,0 +1,395 @@ +{-# LANGUAGE ImpredicativeTypes #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# 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 (..) + , 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 + +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/tests/Crypto/Ethereum/Test/EIP712SignatureSpec.hs b/tests/Crypto/Ethereum/Test/EIP712SignatureSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Crypto/Ethereum/Test/EIP712SignatureSpec.hs @@ -0,0 +1,220 @@ +{-# LANGUAGE ImpredicativeTypes #-} +{-# 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 +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/tests/Crypto/Ethereum/Test/SignatureSpec.hs b/tests/Crypto/Ethereum/Test/SignatureSpec.hs --- a/tests/Crypto/Ethereum/Test/SignatureSpec.hs +++ b/tests/Crypto/Ethereum/Test/SignatureSpec.hs @@ -30,7 +30,9 @@ ("0xd3ba712ef9dd8f8b37d805a9d1c2b5ee92db66dda0fd8582d55cec1b2519d18dfff2333e29081e80544af7244f2f22", "0x330ee59f080c59252218d1245029d8689b48b021dcf2c438938264bbc61d05af", "0xcf96a0f05e40d05ebcedbff0af522a68e6c846e63b44245a1208592ddf03cc12136ad522656f08fd838c55ff78e093d387d23b30b88a57e467636e63c786e04e1c"), ("0x1e99da3e7bb02e1f239bbf0b2ea113848673dd52da24c87f2f40", "0x52c58101fe861f9292fb6ad3df74551b5fb3feca9983b108645a5a9354bfbe99", "0x8eebcef599eb67e9379e7d6b074123628c1a65f1b754647704eb003fa61aff0a0e5c79fb022970fea80409e20a12bd4b8e1a79a787394a547fbc93c2d3c1e2dc1c"), ("0x1e973d1b5b158acc7d710099700c793e702b215a1fa534317d5c44406000fc727c", "0x1280413acfcd88a97b759e72e60069a1dc4f0a595e815aad9a1a83fa73f81af2", "0x7a77a37f2f4378dab5a0ba7f55b858a2a116f885f2eeab30dcd0b6d1f7286fbb7cbdccbd52721ce68fbcf2448a2f450a6bc6bc7f0027906259821bb3800133181b"), - ("0x95da865540bd1336402a325a0435a920768f47d4b1ec0d89e0063f811872d1cb6423b5f4a4b931c9f41b216def", "0x0d537e54120ea923621225e3114b91a568a1abe7b7315b642017cad28cfad40b", "0xe04196529154ab89ceb598654f7d1ae178ecdcf73395aa8e8abb9200b504c39c58a93a6e502aaaddc2cbd712b436e9c9fb1010323927835ac54a7a77f11957f91c") + ("0x95da865540bd1336402a325a0435a920768f47d4b1ec0d89e0063f811872d1cb6423b5f4a4b931c9f41b216def", "0x0d537e54120ea923621225e3114b91a568a1abe7b7315b642017cad28cfad40b", "0xe04196529154ab89ceb598654f7d1ae178ecdcf73395aa8e8abb9200b504c39c58a93a6e502aaaddc2cbd712b436e9c9fb1010323927835ac54a7a77f11957f91c"), + ("0x5f6f0fb4805de6c07057", "0x2fe8fc66c90cca91bb502d4ab3d9ecec1621ee1d3c3e5837d98fbd1e08484980", "0x5f1760725b719a0f4f06078868511b397d87b7e3a76aa95671ac774587b5d68a000894b31c26288e67190910b7589b36d3ce7d182b8dc4b903e06284ea61fc811b"), + ("0x64ee1efda1b47bd975f7b14737", "0x8bd280c92fdf874ed9cf46616a2da0ce383c3c9c93daa599844168e6883f527d", "0x00f47d9633245b095ba5f9fa8e4f71a02bff785469f0dd1a3b146578d84061c17a4283bea20c54c2c27e8975e51311d6556acd9c19a783cccc0934d4c7592ba61b") ] test_key :: HexString diff --git a/web3-crypto.cabal b/web3-crypto.cabal --- a/web3-crypto.cabal +++ b/web3-crypto.cabal @@ -1,9 +1,9 @@ cabal-version: 1.12 name: web3-crypto -version: 1.0.1.0 +version: 1.1.0.0 license: Apache-2.0 license-file: LICENSE -copyright: (c) Aleksandr Krupenkin 2016-2024 +copyright: (c) Aleksandr Krupenkin 2016-2026 maintainer: mail@akru.me author: Aleksandr Krupenkin homepage: https://github.com/airalab/hs-web3#readme @@ -28,6 +28,7 @@ Crypto.Ecdsa.Signature Crypto.Ecdsa.Utils Crypto.Ethereum + Crypto.Ethereum.Eip712Signature Crypto.Ethereum.Keyfile Crypto.Ethereum.Signature Crypto.Ethereum.Utils @@ -51,16 +52,18 @@ -Wunused-foralls -Wtabs build-depends: - aeson >1.2 && <2.2, - base >4.11 && <4.19, - bytestring >0.10 && <0.12, - containers >0.6 && <0.7, - crypton >0.30 && <1.0, - memory >0.14 && <0.19, - memory-hexstring >=1.0 && <1.1, - text >1.2 && <2.1, - uuid-types >1.0 && <1.1, - vector >0.12 && <0.14 + aeson >=1.2 && <2.3, + base >=4.11 && <4.21, + basement >=0.0.16 && <0.1, + bytestring >=0.10 && <0.13, + containers >=0.6 && <0.8, + crypton >=0.30 && <1.1, + memory >=0.14 && <0.19, + memory-hexstring >=1.0 && <1.2, + scientific >=0.3.7 && <0.4, + text >=1.2 && <2.2, + uuid-types >=1.0 && <1.1, + vector >=0.12 && <0.14 test-suite tests type: exitcode-stdio-1.0 @@ -68,6 +71,7 @@ c-sources: src/cbits/xxhash.c hs-source-dirs: tests src other-modules: + Crypto.Ethereum.Test.EIP712SignatureSpec Crypto.Ethereum.Test.KeyfileSpec Crypto.Ethereum.Test.SignatureSpec Crypto.Random.Test.HmacDrbgSpec @@ -77,6 +81,7 @@ Crypto.Ecdsa.Signature Crypto.Ecdsa.Utils Crypto.Ethereum + Crypto.Ethereum.Eip712Signature Crypto.Ethereum.Keyfile Crypto.Ethereum.Signature Crypto.Ethereum.Utils @@ -98,17 +103,19 @@ -Wunused-foralls -Wtabs -threaded -rtsopts -with-rtsopts=-N build-depends: - aeson >1.2 && <2.2, - base >4.11 && <4.19, - bytestring >0.10 && <0.12, - containers >0.6 && <0.7, - crypton >0.30 && <1.0, + aeson >=1.2 && <2.3, + base >=4.11 && <4.21, + basement >=0.0.16 && <0.1, + bytestring >=0.10 && <0.13, + containers >=0.6 && <0.8, + crypton >=0.30 && <1.1, hspec >=2.4.4 && <2.12, hspec-contrib >=0.4.0 && <0.6, hspec-discover >=2.4.4 && <2.12, hspec-expectations >=0.8.2 && <0.9, - memory >0.14 && <0.19, - memory-hexstring >=1.0 && <1.1, - text >1.2 && <2.1, - uuid-types >1.0 && <1.1, - vector >0.12 && <0.14 + memory >=0.14 && <0.19, + memory-hexstring >=1.0 && <1.2, + scientific >=0.3.7 && <0.4, + text >=1.2 && <2.2, + uuid-types >=1.0 && <1.1, + vector >=0.12 && <0.14