packages feed

web3-crypto 1.0.1.0 → 1.1.0.0

raw patch · 6 files changed

+657/−26 lines, 6 filesdep +basementdep +scientificdep ~aesondep ~basedep ~bytestringPVP ok

version bump matches the API change (PVP)

Dependencies added: basement, scientific

Dependency ranges changed: aeson, base, bytestring, containers, crypton, memory, memory-hexstring, text, uuid-types, vector

API changes (from Hackage documentation)

+ Crypto.Ethereum.Eip712Signature: EIP712Field :: EIP712Name -> EIP712FieldType -> EIP712Field
+ Crypto.Ethereum.Eip712Signature: EIP712Struct :: EIP712Name -> [EIP712Field] -> EIP712Struct
+ Crypto.Ethereum.Eip712Signature: EIP712TypedData :: EIP712Types -> EIP712Name -> Object -> Object -> EIP712TypedData
+ Crypto.Ethereum.Eip712Signature: FieldTypeAddress :: EIP712FieldType
+ Crypto.Ethereum.Eip712Signature: FieldTypeArray :: EIP712FieldType -> EIP712FieldType
+ Crypto.Ethereum.Eip712Signature: FieldTypeArrayN :: Natural -> EIP712FieldType -> EIP712FieldType
+ Crypto.Ethereum.Eip712Signature: FieldTypeBool :: EIP712FieldType
+ Crypto.Ethereum.Eip712Signature: FieldTypeBytes :: EIP712FieldType
+ Crypto.Ethereum.Eip712Signature: FieldTypeBytesN :: ByteWidth -> EIP712FieldType
+ Crypto.Ethereum.Eip712Signature: FieldTypeInt :: BitWidth -> EIP712FieldType
+ Crypto.Ethereum.Eip712Signature: FieldTypeString :: EIP712FieldType
+ Crypto.Ethereum.Eip712Signature: FieldTypeStruct :: EIP712Name -> EIP712FieldType
+ Crypto.Ethereum.Eip712Signature: FieldTypeUInt :: BitWidth -> EIP712FieldType
+ Crypto.Ethereum.Eip712Signature: S1 :: ByteWidth
+ Crypto.Ethereum.Eip712Signature: S10 :: ByteWidth
+ Crypto.Ethereum.Eip712Signature: S11 :: ByteWidth
+ Crypto.Ethereum.Eip712Signature: S12 :: ByteWidth
+ Crypto.Ethereum.Eip712Signature: S13 :: ByteWidth
+ Crypto.Ethereum.Eip712Signature: S14 :: ByteWidth
+ Crypto.Ethereum.Eip712Signature: S15 :: ByteWidth
+ Crypto.Ethereum.Eip712Signature: S16 :: ByteWidth
+ Crypto.Ethereum.Eip712Signature: S17 :: ByteWidth
+ Crypto.Ethereum.Eip712Signature: S18 :: ByteWidth
+ Crypto.Ethereum.Eip712Signature: S19 :: ByteWidth
+ Crypto.Ethereum.Eip712Signature: S2 :: ByteWidth
+ Crypto.Ethereum.Eip712Signature: S20 :: ByteWidth
+ Crypto.Ethereum.Eip712Signature: S21 :: ByteWidth
+ Crypto.Ethereum.Eip712Signature: S22 :: ByteWidth
+ Crypto.Ethereum.Eip712Signature: S23 :: ByteWidth
+ Crypto.Ethereum.Eip712Signature: S24 :: ByteWidth
+ Crypto.Ethereum.Eip712Signature: S25 :: ByteWidth
+ Crypto.Ethereum.Eip712Signature: S26 :: ByteWidth
+ Crypto.Ethereum.Eip712Signature: S27 :: ByteWidth
+ Crypto.Ethereum.Eip712Signature: S28 :: ByteWidth
+ Crypto.Ethereum.Eip712Signature: S29 :: ByteWidth
+ Crypto.Ethereum.Eip712Signature: S3 :: ByteWidth
+ Crypto.Ethereum.Eip712Signature: S30 :: ByteWidth
+ Crypto.Ethereum.Eip712Signature: S31 :: ByteWidth
+ Crypto.Ethereum.Eip712Signature: S32 :: ByteWidth
+ Crypto.Ethereum.Eip712Signature: S4 :: ByteWidth
+ Crypto.Ethereum.Eip712Signature: S5 :: ByteWidth
+ Crypto.Ethereum.Eip712Signature: S6 :: ByteWidth
+ Crypto.Ethereum.Eip712Signature: S7 :: ByteWidth
+ Crypto.Ethereum.Eip712Signature: S8 :: ByteWidth
+ Crypto.Ethereum.Eip712Signature: S9 :: ByteWidth
+ Crypto.Ethereum.Eip712Signature: Si104 :: BitWidth
+ Crypto.Ethereum.Eip712Signature: Si112 :: BitWidth
+ Crypto.Ethereum.Eip712Signature: Si120 :: BitWidth
+ Crypto.Ethereum.Eip712Signature: Si128 :: BitWidth
+ Crypto.Ethereum.Eip712Signature: Si136 :: BitWidth
+ Crypto.Ethereum.Eip712Signature: Si144 :: BitWidth
+ Crypto.Ethereum.Eip712Signature: Si152 :: BitWidth
+ Crypto.Ethereum.Eip712Signature: Si16 :: BitWidth
+ Crypto.Ethereum.Eip712Signature: Si160 :: BitWidth
+ Crypto.Ethereum.Eip712Signature: Si168 :: BitWidth
+ Crypto.Ethereum.Eip712Signature: Si176 :: BitWidth
+ Crypto.Ethereum.Eip712Signature: Si184 :: BitWidth
+ Crypto.Ethereum.Eip712Signature: Si192 :: BitWidth
+ Crypto.Ethereum.Eip712Signature: Si200 :: BitWidth
+ Crypto.Ethereum.Eip712Signature: Si208 :: BitWidth
+ Crypto.Ethereum.Eip712Signature: Si216 :: BitWidth
+ Crypto.Ethereum.Eip712Signature: Si224 :: BitWidth
+ Crypto.Ethereum.Eip712Signature: Si232 :: BitWidth
+ Crypto.Ethereum.Eip712Signature: Si24 :: BitWidth
+ Crypto.Ethereum.Eip712Signature: Si240 :: BitWidth
+ Crypto.Ethereum.Eip712Signature: Si248 :: BitWidth
+ Crypto.Ethereum.Eip712Signature: Si256 :: BitWidth
+ Crypto.Ethereum.Eip712Signature: Si32 :: BitWidth
+ Crypto.Ethereum.Eip712Signature: Si40 :: BitWidth
+ Crypto.Ethereum.Eip712Signature: Si48 :: BitWidth
+ Crypto.Ethereum.Eip712Signature: Si56 :: BitWidth
+ Crypto.Ethereum.Eip712Signature: Si64 :: BitWidth
+ Crypto.Ethereum.Eip712Signature: Si72 :: BitWidth
+ Crypto.Ethereum.Eip712Signature: Si8 :: BitWidth
+ Crypto.Ethereum.Eip712Signature: Si80 :: BitWidth
+ Crypto.Ethereum.Eip712Signature: Si88 :: BitWidth
+ Crypto.Ethereum.Eip712Signature: Si96 :: BitWidth
+ Crypto.Ethereum.Eip712Signature: [eip712FieldName] :: EIP712Field -> EIP712Name
+ Crypto.Ethereum.Eip712Signature: [eip712FieldType] :: EIP712Field -> EIP712FieldType
+ Crypto.Ethereum.Eip712Signature: [eip712StructFields] :: EIP712Struct -> [EIP712Field]
+ Crypto.Ethereum.Eip712Signature: [eip712StructName] :: EIP712Struct -> EIP712Name
+ Crypto.Ethereum.Eip712Signature: [typedDataDomain] :: EIP712TypedData -> Object
+ Crypto.Ethereum.Eip712Signature: [typedDataMessage] :: EIP712TypedData -> Object
+ Crypto.Ethereum.Eip712Signature: [typedDataPrimaryType] :: EIP712TypedData -> EIP712Name
+ Crypto.Ethereum.Eip712Signature: [typedDataTypes] :: EIP712TypedData -> EIP712Types
+ Crypto.Ethereum.Eip712Signature: bytesOf :: HasWidth a => a -> Int
+ Crypto.Ethereum.Eip712Signature: class HasWidth a
+ Crypto.Ethereum.Eip712Signature: data BitWidth
+ Crypto.Ethereum.Eip712Signature: data ByteWidth
+ Crypto.Ethereum.Eip712Signature: data EIP712Field
+ Crypto.Ethereum.Eip712Signature: data EIP712FieldType
+ Crypto.Ethereum.Eip712Signature: data EIP712Struct
+ Crypto.Ethereum.Eip712Signature: data EIP712TypedData
+ Crypto.Ethereum.Eip712Signature: encodeData :: ByteArray bout => EIP712Types -> EIP712Name -> Object -> Either String bout
+ Crypto.Ethereum.Eip712Signature: encodeType :: ByteArray bout => EIP712Types -> EIP712Name -> Either String bout
+ Crypto.Ethereum.Eip712Signature: hashStruct :: ByteArray bout => EIP712Types -> EIP712Name -> Object -> Either String bout
+ Crypto.Ethereum.Eip712Signature: instance Crypto.Ethereum.Eip712Signature.EIP712Encoded Crypto.Ethereum.Eip712Signature.EIP712Field
+ Crypto.Ethereum.Eip712Signature: instance Crypto.Ethereum.Eip712Signature.EIP712Encoded Crypto.Ethereum.Eip712Signature.EIP712FieldType
+ Crypto.Ethereum.Eip712Signature: instance Crypto.Ethereum.Eip712Signature.HasWidth Crypto.Ethereum.Eip712Signature.BitWidth
+ Crypto.Ethereum.Eip712Signature: instance Crypto.Ethereum.Eip712Signature.HasWidth Crypto.Ethereum.Eip712Signature.ByteWidth
+ Crypto.Ethereum.Eip712Signature: instance Data.Aeson.Types.ToJSON.ToJSON Crypto.Ethereum.Eip712Signature.EIP712Field
+ Crypto.Ethereum.Eip712Signature: instance Data.Aeson.Types.ToJSON.ToJSON Crypto.Ethereum.Eip712Signature.EIP712TypedData
+ Crypto.Ethereum.Eip712Signature: instance GHC.Classes.Eq Crypto.Ethereum.Eip712Signature.BitWidth
+ Crypto.Ethereum.Eip712Signature: instance GHC.Classes.Eq Crypto.Ethereum.Eip712Signature.ByteWidth
+ Crypto.Ethereum.Eip712Signature: instance GHC.Classes.Eq Crypto.Ethereum.Eip712Signature.EIP712Field
+ Crypto.Ethereum.Eip712Signature: instance GHC.Classes.Eq Crypto.Ethereum.Eip712Signature.EIP712FieldType
+ Crypto.Ethereum.Eip712Signature: instance GHC.Classes.Eq Crypto.Ethereum.Eip712Signature.EIP712Struct
+ Crypto.Ethereum.Eip712Signature: instance GHC.Enum.Bounded Crypto.Ethereum.Eip712Signature.BitWidth
+ Crypto.Ethereum.Eip712Signature: instance GHC.Enum.Bounded Crypto.Ethereum.Eip712Signature.ByteWidth
+ Crypto.Ethereum.Eip712Signature: instance GHC.Enum.Enum Crypto.Ethereum.Eip712Signature.BitWidth
+ Crypto.Ethereum.Eip712Signature: instance GHC.Enum.Enum Crypto.Ethereum.Eip712Signature.ByteWidth
+ Crypto.Ethereum.Eip712Signature: instance GHC.Show.Show Crypto.Ethereum.Eip712Signature.BitWidth
+ Crypto.Ethereum.Eip712Signature: instance GHC.Show.Show Crypto.Ethereum.Eip712Signature.ByteWidth
+ Crypto.Ethereum.Eip712Signature: instance GHC.Show.Show Crypto.Ethereum.Eip712Signature.EIP712Field
+ Crypto.Ethereum.Eip712Signature: instance GHC.Show.Show Crypto.Ethereum.Eip712Signature.EIP712FieldType
+ Crypto.Ethereum.Eip712Signature: instance GHC.Show.Show Crypto.Ethereum.Eip712Signature.EIP712Struct
+ Crypto.Ethereum.Eip712Signature: instance GHC.Show.Show Crypto.Ethereum.Eip712Signature.EIP712TypedData
+ Crypto.Ethereum.Eip712Signature: signTypedData :: ByteArray rsv => PrivateKey -> EIP712TypedData -> Either String rsv
+ Crypto.Ethereum.Eip712Signature: signTypedData' :: PrivateKey -> EIP712TypedData -> Either String (Integer, Integer, Word8)
+ Crypto.Ethereum.Eip712Signature: type EIP712Name = Text
+ Crypto.Ethereum.Eip712Signature: type EIP712Types = [EIP712Struct]
+ Crypto.Ethereum.Eip712Signature: typedDataSignHash :: ByteArray bout => EIP712TypedData -> Either String bout
- Crypto.Ethereum: data () => PrivateKey
+ Crypto.Ethereum: data PrivateKey
- Crypto.Ethereum: data () => PublicKey
+ Crypto.Ethereum: data PublicKey

Files

LICENSE view
@@ -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.
src/Crypto/Ecdsa/Signature.hs view
@@ -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
+ src/Crypto/Ethereum/Eip712Signature.hs view
@@ -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
+ tests/Crypto/Ethereum/Test/EIP712SignatureSpec.hs view
@@ -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"
tests/Crypto/Ethereum/Test/SignatureSpec.hs view
@@ -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
web3-crypto.cabal view
@@ -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