web3-solidity 1.0.0.0 → 1.0.1.0

raw patch · 21 files changed

+363/−198 lines, 21 filesdep ~OneTupledep ~aesondep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: OneTuple, aeson, base, bytestring, hspec, hspec-discover, memory, template-haskell, text

API changes (from Hackage documentation)

Files

• src/Data/Solidity/Abi.hs +2/−1
• src/Data/Solidity/Abi/Codec.hs +3/−2
• src/Data/Solidity/Abi/Generic.hs +55/−43
• src/Data/Solidity/Event.hs +1/−1
• src/Data/Solidity/Event/Internal.hs +1/−1
• src/Data/Solidity/Prim.hs +1/−1
• src/Data/Solidity/Prim/Address.hs +1/−1
• src/Data/Solidity/Prim/Bool.hs +1/−1
• src/Data/Solidity/Prim/Bytes.hs +14/−13
• src/Data/Solidity/Prim/Int.hs +24/−17
• src/Data/Solidity/Prim/List.hs +51/−11
• src/Data/Solidity/Prim/String.hs +1/−1
• src/Data/Solidity/Prim/Tagged.hs +1/−1
• src/Data/Solidity/Prim/Tuple.hs +26/−6
• src/Data/Solidity/Prim/Tuple/TH.hs +3/−3
• src/Language/Solidity/Abi.hs +54/−37
• tests/Data/Solidity/Test/AddressSpec.hs +11/−0
• tests/Data/Solidity/Test/EncodingSpec.hs +12/−1
• tests/Data/Solidity/Test/IntSpec.hs +11/−0
• tests/Language/Solidity/Test/AbiSpec.hs +56/−22
• web3-solidity.cabal +34/−35

@@ -1,10 +1,11 @@ {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleContexts  #-} {-# LANGUAGE TypeFamilies      #-}+{-# LANGUAGE TypeOperators     #-}  -- | -- Module      :  Data.Solidity.Abi--- Copyright   :  Aleksandr Krupenkin 2016-2021+-- Copyright   :  Aleksandr Krupenkin 2016-2024 -- License     :  Apache-2.0 -- -- Maintainer  :  mail@akru.me

@@ -1,8 +1,9 @@-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeFamilies  #-}+{-# LANGUAGE TypeOperators #-}  -- | -- Module      :  Data.Solidity.Abi.Codec--- Copyright   :  Aleksandr Krupenkin 2016-2021+-- Copyright   :  Aleksandr Krupenkin 2016-2024 -- License     :  Apache-2.0 -- -- Maintainer  :  mail@akru.me

@@ -9,7 +9,7 @@  -- | -- Module      :  Data.Solidity.Abi.Generic--- Copyright   :  Aleksandr Krupenkin 2016-2021+-- Copyright   :  Aleksandr Krupenkin 2016-2024 -- License     :  Apache-2.0 -- -- Maintainer  :  mail@akru.me@@ -37,65 +37,77 @@ import           Data.Solidity.Prim.Int (getWord256, putWord256)  data EncodedValue = EncodedValue-    { order    :: Int64-    , offset   :: Maybe Int64-    , encoding :: Put+    { evOrder                 :: Int64+    , evIsDynamic             :: Bool+    , evEncoding              :: Put+    , evEncodingLengthInBytes :: Int64 -- cache     }  instance Eq EncodedValue where-  ev1 == ev2 = order ev1 == order ev2+  ev1 == ev2 = evOrder ev1 == evOrder ev2  instance Ord EncodedValue where-  compare ev1 ev2 = order ev1 `compare` order ev2+  compare ev1 ev2 = evOrder ev1 `compare` evOrder ev2 +-- from https://docs.soliditylang.org/en/v0.8.12/abi-spec.html#examples+--+-- if Ti is static:+--   head(X(i)) = enc(X(i)) and tail(X(i)) = "" (the empty string)+-- otherwise, i.e. if Ti is dynamic:+--   head(X(i)) = enc(len( head(X(1)) ... head(X(k)) tail(X(1)) ... tail(X(i-1)) )) tail(X(i)) = enc(X(i)) combineEncodedValues :: [EncodedValue] -> Put combineEncodedValues encodings =-  let sortedEs = adjust headsOffset $ L.sort encodings-      encodings' = addTailOffsets headsOffset [] sortedEs-  in let heads = foldl (\acc EncodedValue{..} -> case offset of-                          Nothing -> acc <> encoding-                          Just o  -> acc <> putWord256 (fromIntegral o)-                      ) mempty encodings'-         tails = foldl (\acc EncodedValue{..} -> case offset of-                          Nothing -> acc-                          Just _  -> acc <> encoding-                      ) mempty encodings'+  let sortedEncodings = L.sort encodings++      wordLengthInBytes :: Int64+      wordLengthInBytes = 32++      headsOffsetInBytes :: Int64+      headsOffsetInBytes = foldl (+) 0 $ map (\EncodedValue{..} -> if evIsDynamic then wordLengthInBytes else evEncodingLengthInBytes) encodings++      heads = fst $ foldl+        (\(accumulator, lengthOfPreviousDynamicValues) EncodedValue{..} -> if evIsDynamic+            then ( accumulator <> putWord256 (fromIntegral $ headsOffsetInBytes + lengthOfPreviousDynamicValues)+                 , lengthOfPreviousDynamicValues + evEncodingLengthInBytes+                 )+            else ( accumulator <> evEncoding+                 , lengthOfPreviousDynamicValues+                 )+        )+        (mempty, 0)+        sortedEncodings+      tails = foldMap+        (\EncodedValue{..} -> if evIsDynamic+            then evEncoding+            else mempty+        )+        sortedEncodings       in heads <> tails   where-    adjust :: Int64 -> [EncodedValue] -> [EncodedValue]-    adjust n = map (\ev -> ev {offset = (+) n <$> offset ev})-    addTailOffsets :: Int64 -> [EncodedValue] -> [EncodedValue] -> [EncodedValue]-    addTailOffsets init' acc es = case es of-      [] -> reverse acc-      (e : tail') -> case offset e of-        Nothing -> addTailOffsets init' (e : acc) tail'-        Just _  -> addTailOffsets init' (e : acc) (adjust (LBS.length . runPutLazy . encoding $ e) tail')-    headsOffset :: Int64-    headsOffset = foldl (\acc e -> case offset e of-                                Nothing -> acc + (LBS.length . runPutLazy . encoding $ e)-                                Just _ -> acc + 32-                            ) 0 encodings +-- aIsDynamic is a variable because of https://github.com/airalab/hs-web3/pull/129#issuecomment-1074045478+-- TODO: call the `isDynamic` function in the `mkEncodedValue` function+mkEncodedValue :: (AbiType a, AbiPut a) => [EncodedValue] -> a -> Bool -> EncodedValue+mkEncodedValue otherEncodedArray a aIsDynamic =+  let encoding = abiPut a+  in EncodedValue+  { evEncoding              = encoding+  , evOrder                 = fromInteger . toInteger . L.length $ otherEncodedArray+  , evIsDynamic             = aIsDynamic+  , evEncodingLengthInBytes = lengthInBytes encoding+  }+  where+  lengthInBytes :: Put -> Int64+  lengthInBytes e = LBS.length . runPutLazy $ e+ class AbiData a where     _serialize :: [EncodedValue] -> a -> [EncodedValue]  instance AbiData (NP f '[]) where     _serialize encoded _ = encoded -instance (AbiType b, AbiPut b, AbiData (NP I as)) => AbiData (NP I (b :as)) where-    _serialize encoded (I b :* a) =-        if isDynamic (Proxy :: Proxy b)-        then _serialize (dynEncoding  : encoded) a-        else _serialize (staticEncoding : encoded) a-      where-        staticEncoding = EncodedValue { encoding = abiPut b-                                      , offset = Nothing-                                      , order = 1 + (fromInteger . toInteger . L.length $ encoded)-                                      }-        dynEncoding = EncodedValue { encoding = abiPut b-                                   , offset = Just 0-                                   , order = 1 + (fromInteger . toInteger . L.length $ encoded)-                                   }+instance (AbiType b, AbiPut b, AbiData (NP I as)) => AbiData (NP I (b : as)) where+    _serialize encoded (I b :* a) = _serialize (mkEncodedValue encoded b (isDynamic (Proxy :: Proxy b)) : encoded) a  instance AbiData (NP f as) => GenericAbiPut (SOP f '[as]) where     gAbiPut (SOP (Z a)) = combineEncodedValues $ _serialize [] a

@@ -10,7 +10,7 @@  -- | -- Module      :  Data.Solidity.Event--- Copyright   :  Aleksandr Krupenkin 2016-2021+-- Copyright   :  Aleksandr Krupenkin 2016-2024 -- License     :  Apache-2.0 -- -- Maintainer  :  mail@akru.me

@@ -12,7 +12,7 @@  -- | -- Module      :  Data.Solidity.Event.Internal--- Copyright   :  Aleksandr Krupenkin 2016-2021+-- Copyright   :  Aleksandr Krupenkin 2016-2024 -- License     :  Apache-2.0 -- -- Maintainer  :  mail@akru.me

@@ -1,6 +1,6 @@ -- | -- Module      :  Data.Solidity.Prim--- Copyright   :  Aleksandr Krupenkin 2016-2021+-- Copyright   :  Aleksandr Krupenkin 2016-2024 -- License     :  Apache-2.0 -- -- Maintainer  :  mail@akru.me

@@ -4,7 +4,7 @@  -- | -- Module      :  Data.Solidity.Prim.Address--- Copyright   :  Aleksandr Krupenkin 2016-2021+-- Copyright   :  Aleksandr Krupenkin 2016-2024 -- License     :  Apache-2.0 -- -- Maintainer  :  mail@akru.me

@@ -1,6 +1,6 @@ -- | -- Module      :  Data.Solidity.Prim.Bool--- Copyright   :  Aleksandr Krupenkin 2016-2021+-- Copyright   :  Aleksandr Krupenkin 2016-2024 -- License     :  Apache-2.0 -- -- Maintainer  :  mail@akru.me

@@ -1,14 +1,15 @@-{-# LANGUAGE DataKinds           #-}-{-# LANGUAGE FlexibleContexts    #-}-{-# LANGUAGE FlexibleInstances   #-}-{-# LANGUAGE OverloadedStrings   #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies        #-}-{-# LANGUAGE TypeOperators       #-}+{-# LANGUAGE DataKinds            #-}+{-# LANGUAGE FlexibleContexts     #-}+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE OverloadedStrings    #-}+{-# LANGUAGE ScopedTypeVariables  #-}+{-# LANGUAGE TypeFamilies         #-}+{-# LANGUAGE TypeOperators        #-}+{-# LANGUAGE UndecidableInstances #-}  -- | -- Module      :  Data.Solidity.Prim.Bytes--- Copyright   :  Aleksandr Krupenkin 2016-2021+-- Copyright   :  Aleksandr Krupenkin 2016-2024 -- License     :  Apache-2.0 -- -- Maintainer  :  mail@akru.me@@ -85,7 +86,7 @@ -- | Sized byte array with fixed length in bytes type BytesN n = SizedByteArray n Bytes -instance (n <= 32) => AbiType (BytesN n) where+instance KnownNat n => AbiType (BytesN n) where     isDynamic _ = False  instance (KnownNat n, n <= 32) => AbiGet (BytesN n) where@@ -93,21 +94,21 @@         ba <- unsafeFromByteArrayAccess <$> getBytes 32         return $ S.take (ba :: BytesN 32) -instance (KnownNat n, n <= 32) => AbiPut (BytesN n) where+instance KnownNat n => AbiPut (BytesN n) where     abiPut ba = putByteString $ convert ba <> zero (32 - len)       where len = fromIntegral $ natVal (Proxy :: Proxy n) -instance (KnownNat n, n <= 32) => IsString (BytesN n) where+instance KnownNat n => IsString (BytesN n) where     fromString s = unsafeFromByteArrayAccess padded       where bytes = fromString s :: Bytes             len = fromIntegral $ natVal (Proxy :: Proxy n)             padded = bytes <> zero (len - length bytes) -instance (KnownNat n, n <= 32) => FromJSON (BytesN n) where+instance KnownNat n => FromJSON (BytesN n) where     parseJSON v = do ba <- parseJSON v                      return $ unsafeFromByteArrayAccess (ba :: Bytes) -instance (KnownNat n, n <= 32) => ToJSON (BytesN n) where+instance KnownNat n => ToJSON (BytesN n) where     toJSON ba = toJSON (unSizedByteArray ba :: Bytes)  abiGetByteString :: Get ByteString

@@ -8,7 +8,7 @@  -- | -- Module      :  Data.Solidity.Prim.Int--- Copyright   :  Aleksandr Krupenkin 2016-2021+-- Copyright   :  Aleksandr Krupenkin 2016-2024 -- License     :  Apache-2.0 -- -- Maintainer  :  mail@akru.me@@ -34,6 +34,7 @@ import qualified Basement.Numerical.Number as Basement (toInteger) import           Basement.Types.Word256    (Word256 (Word256)) import qualified Basement.Types.Word256    as Basement (quot, rem)+import           Data.Aeson                (ToJSON (..)) import           Data.Bits                 (Bits (testBit), (.&.)) import           Data.Proxy                (Proxy (..)) import           Data.Serialize            (Get, Putter, Serialize (get, put))@@ -54,7 +55,7 @@ newtype UIntN (n :: Nat) = UIntN { unUIntN :: Word256 }     deriving (Eq, Ord, Enum, Bits, Generic) -instance (KnownNat n, n <= 256) => Num (UIntN n) where+instance KnownNat n => Num (UIntN n) where     a + b  = fromInteger (toInteger a + toInteger b)     a - b  = fromInteger (toInteger a - toInteger b)     a * b  = fromInteger (toInteger a * toInteger b)@@ -67,41 +68,44 @@       where         mask = (maxBound .&.) :: UIntN n -> UIntN n -instance (KnownNat n, n <= 256) => Show (UIntN n) where+instance KnownNat n => Show (UIntN n) where     show = show . unUIntN -instance (KnownNat n, n <= 256) => Bounded (UIntN n) where+instance KnownNat n => Bounded (UIntN n) where     minBound = UIntN 0     maxBound = UIntN $ 2 ^ natVal (Proxy :: Proxy n) - 1 -instance (KnownNat n, n <= 256) => Real (UIntN n) where+instance KnownNat n => Real (UIntN n) where     toRational = toRational . toInteger -instance (KnownNat n, n <= 256) => Integral (UIntN n) where+instance KnownNat n => Integral (UIntN n) where     toInteger = toInteger . unUIntN     quotRem (UIntN a) (UIntN b) = (UIntN $ quot a b, UIntN $ rem a b) -instance (n <= 256) => AbiType (UIntN n) where+instance KnownNat n => AbiType (UIntN n) where     isDynamic _ = False -instance (n <= 256) => AbiGet (UIntN n) where+instance KnownNat n => AbiGet (UIntN n) where     abiGet = UIntN <$> getWord256 -instance (n <= 256) => AbiPut (UIntN n) where+instance KnownNat n => AbiPut (UIntN n) where     abiPut = putWord256 . unUIntN +instance KnownNat n => ToJSON (UIntN n) where+  toJSON = toJSON . toInteger+ -- | Signed integer with fixed length in bits. newtype IntN (n :: Nat) = IntN { unIntN :: Word256 }     deriving (Eq, Ord, Enum, Bits, Generic) -instance (KnownNat n, n <= 256) => Show (IntN n) where+instance KnownNat n => Show (IntN n) where     show = show . toInteger -instance (KnownNat n, n <= 256) => Bounded (IntN n) where+instance KnownNat n => Bounded (IntN n) where     minBound = IntN $ negate $ 2 ^ (natVal (Proxy :: Proxy (n :: Nat)) - 1)     maxBound = IntN $ 2 ^ (natVal (Proxy :: Proxy (n :: Nat)) - 1) - 1 -instance (KnownNat n, n <= 256) => Num (IntN n) where+instance KnownNat n => Num (IntN n) where     a + b  = fromInteger (toInteger a + toInteger b)     a - b  = fromInteger (toInteger a - toInteger b)     a * b  = fromInteger (toInteger a * toInteger b)@@ -112,23 +116,26 @@       | x >= 0 = IntN (fromInteger x)       | otherwise = IntN (fromInteger $ 2 ^ 256 + x) -instance (KnownNat n, n <= 256) => Real (IntN n) where+instance KnownNat n => Real (IntN n) where     toRational = toRational . toInteger -instance (KnownNat n, n <= 256) => Integral (IntN n) where+instance KnownNat n => Integral (IntN n) where     quotRem (IntN a) (IntN b) = (IntN $ quot a b, IntN $ rem a b)     toInteger x       | testBit x 255 = toInteger (unIntN x) - 2 ^ 256       | otherwise = toInteger $ unIntN x -instance (n <= 256) => AbiType (IntN n) where+instance KnownNat n => AbiType (IntN n) where     isDynamic _ = False -instance (n <= 256) => AbiGet (IntN n) where+instance KnownNat n => AbiGet (IntN n) where     abiGet = IntN <$> getWord256 -instance (n <= 256) => AbiPut (IntN n) where+instance KnownNat n => AbiPut (IntN n) where     abiPut = putWord256 . unIntN++instance KnownNat n => ToJSON (IntN n) where+  toJSON = toJSON . toInteger  -- | Serialize 256 bit unsigned integer. putWord256 :: Putter Word256

@@ -1,10 +1,13 @@+{-# LANGUAGE DataKinds            #-} {-# LANGUAGE FlexibleContexts     #-}+{-# LANGUAGE ScopedTypeVariables  #-} {-# LANGUAGE TypeFamilies         #-}+{-# LANGUAGE TypeOperators        #-} {-# LANGUAGE UndecidableInstances #-}  -- | -- Module      :  Data.Solidity.Prim.List--- Copyright   :  Aleksandr Krupenkin 2016-2021+-- Copyright   :  Aleksandr Krupenkin 2016-2024 -- License     :  Apache-2.0 -- -- Maintainer  :  mail@akru.me@@ -22,10 +25,17 @@  import           Basement.Nat           (NatWithinBound) import           Basement.Sized.List    (ListN, toListN_, unListN)-import qualified Basement.Sized.List    as SL (mapM_, replicateM)-import           Control.Monad          (replicateM)+import qualified Basement.Sized.List    as SL (init, map, mapM, mapM_,+                                               replicateM, scanl')+import           Basement.Types.Word256 (Word256)+import           Control.Monad          (forM, replicateM)+import qualified Data.ByteString        as B+import           Data.List              (scanl')+import           Data.Proxy             (Proxy (..))+import           Data.Serialize.Get     (lookAhead, skip)+import           Data.Serialize.Put     (putByteString, runPut) import           GHC.Exts               (IsList (..))-import           GHC.TypeLits           (KnownNat)+import           GHC.TypeLits           (KnownNat, natVal, type (+), type (<=))  import           Data.Solidity.Abi      (AbiGet (..), AbiPut (..), AbiType (..)) import           Data.Solidity.Prim.Int (getWord256, putWord256)@@ -35,20 +45,50 @@  instance AbiPut a => AbiPut [a] where     abiPut l = do putWord256 $ fromIntegral (length l)-                  foldMap abiPut l+                  if isDynamic (Proxy :: Proxy a) then do+                      let encs = map (runPut . abiPut) l+                          lengths = map ((fromIntegral :: Int -> Word256) . B.length) encs+                          offsets = init $ scanl' (+) (fromIntegral (0x20 * length l)) lengths+                      mapM_ putWord256 offsets+                      mapM_ putByteString encs+                    else+                      foldMap abiPut l  instance AbiGet a => AbiGet [a] where     abiGet = do len <- fromIntegral <$> getWord256-                replicateM len abiGet+                if isDynamic (Proxy :: Proxy a) then do+                    offsets <- replicateM len getWord256+                    let currentOffset = 0x20 * len+                    forM offsets $ \dataOffset -> lookAhead $ do+                        skip (fromIntegral dataOffset - currentOffset)+                        abiGet+                  else+                    replicateM len abiGet -instance AbiType (ListN n a) where-    isDynamic _ = False+instance (AbiType a, KnownNat n) => AbiType (ListN n a) where+    isDynamic _ = natVal (Proxy :: Proxy n) > 0 && isDynamic (Proxy :: Proxy a) -instance AbiPut a => AbiPut (ListN n a) where-    abiPut = SL.mapM_ abiPut+instance (AbiPut a, KnownNat n, 1 <= n+1) => AbiPut (ListN n a) where+    abiPut l = if isDynamic (Proxy :: Proxy a) then do+                   let encs = SL.map (runPut . abiPut) l+                       lengths = SL.map ((fromIntegral :: Int -> Word256) . B.length) encs+                       len = natVal (Proxy :: Proxy n)+                       offsets = SL.init $ SL.scanl' (+) (fromIntegral (0x20 * len)) lengths+                   SL.mapM_ putWord256 offsets+                   SL.mapM_ putByteString encs+               else+                   SL.mapM_ abiPut l  instance (NatWithinBound Int n, KnownNat n, AbiGet a) => AbiGet (ListN n a) where-    abiGet = SL.replicateM abiGet+    abiGet = do let len = fromInteger (natVal (Proxy :: Proxy n))+                if isDynamic (Proxy :: Proxy a) then do+                    offsets <- SL.replicateM getWord256+                    let currentOffset = 0x20 * len+                    flip SL.mapM offsets $ \dataOffset -> lookAhead $ do+                        skip (fromIntegral dataOffset - currentOffset)+                        abiGet+                  else+                    SL.replicateM abiGet  instance (NatWithinBound Int n, KnownNat n) => IsList (ListN n a) where     type Item (ListN n a) = a

@@ -1,6 +1,6 @@ -- | -- Module      :  Data.Solidity.Prim.String--- Copyright   :  Aleksandr Krupenkin 2016-2021+-- Copyright   :  Aleksandr Krupenkin 2016-2024 -- License     :  Apache-2.0 -- -- Maintainer  :  mail@akru.me

@@ -3,7 +3,7 @@  -- | -- Module      :  Data.Solidity.Prim.Tagged--- Copyright   :  Aleksandr Krupenkin 2016-2021+-- Copyright   :  Aleksandr Krupenkin 2016-2024 -- License     :  Apache-2.0 -- -- Maintainer  :  mail@akru.me

@@ -1,11 +1,13 @@-{-# LANGUAGE DeriveGeneric       #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE StandaloneDeriving  #-}-{-# LANGUAGE TemplateHaskell     #-}+{-# LANGUAGE CPP                  #-}+{-# LANGUAGE DeriveGeneric        #-}+{-# LANGUAGE ScopedTypeVariables  #-}+{-# LANGUAGE StandaloneDeriving   #-}+{-# LANGUAGE TemplateHaskell      #-}+{-# LANGUAGE TypeSynonymInstances #-}  -- | -- Module      :  Data.Solidity.Prim.Tuple--- Copyright   :  Aleksandr Krupenkin 2016-2021+-- Copyright   :  Aleksandr Krupenkin 2016-2024 -- License     :  Apache-2.0 -- -- Maintainer  :  mail@akru.me@@ -18,15 +20,33 @@ module Data.Solidity.Prim.Tuple where  import           Data.Proxy                  (Proxy (..))+#if MIN_VERSION_OneTuple(0,3,0)+import           Data.Tuple.Solo             (Solo (..))+#else import           Data.Tuple.OneTuple         (OneTuple (..))+#endif import           Generics.SOP                (Generic)+#if MIN_VERSION_base(4,15,0)+#else import qualified GHC.Generics                as GHC (Generic)+#endif  import           Data.Solidity.Abi           (AbiGet, AbiPut, AbiType (..)) import           Data.Solidity.Abi.Generic   () import           Data.Solidity.Prim.Tuple.TH (tupleDecs) +#if MIN_VERSION_OneTuple(0,3,0)+instance Generic (Solo a)+instance AbiType a => AbiType (Solo a) where+    isDynamic _ = isDynamic (Proxy :: Proxy a)++instance AbiGet a => AbiGet (Solo a)+instance AbiPut a => AbiPut (Solo a)+#else+#if MIN_VERSION_base(4,15,0)+#else deriving instance GHC.Generic (OneTuple a)+#endif instance Generic (OneTuple a)  instance AbiType a => AbiType (OneTuple a) where@@ -34,5 +54,5 @@  instance AbiGet a => AbiGet (OneTuple a) instance AbiPut a => AbiPut (OneTuple a)-+#endif $(concat <$> mapM tupleDecs [2..20])

@@ -2,7 +2,7 @@  -- | -- Module      :  Data.Solidity.Prim.Tuple.TH--- Copyright   :  Aleksandr Krupenkin 2016-2021+-- Copyright   :  Aleksandr Krupenkin 2016-2024 -- License     :  Apache-2.0 -- -- Maintainer  :  mail@akru.me@@ -19,8 +19,8 @@ import           Control.Monad       (replicateM) import           Data.Proxy import           Language.Haskell.TH (DecsQ, Type (VarT), appT, clause, conT,-                                      cxt, funD, instanceD, listE, newName, normalB,-                                      tupleT)+                                      cxt, funD, instanceD, listE, newName,+                                      normalB, tupleT)  import           Data.Solidity.Abi   (AbiGet, AbiPut, AbiType (..)) 

@@ -1,11 +1,11 @@-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE LambdaCase          #-}+{-# LANGUAGE OverloadedStrings   #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell   #-}+{-# LANGUAGE TemplateHaskell     #-}  -- | -- Module      :  Data.Solidity.Abi.Json--- Copyright   :  Aleksandr Krupenkin 2016-2021+-- Copyright   :  Aleksandr Krupenkin 2016-2024 -- License     :  Apache-2.0 -- -- Maintainer  :  mail@akru.me@@ -37,9 +37,11 @@  import           Control.Monad            (void) import           Crypto.Ethereum.Utils    (keccak256)-import           Data.Aeson               (FromJSON (parseJSON), Options (constructorTagModifier, fieldLabelModifier, sumEncoding),+import           Data.Aeson               (FromJSON (parseJSON),+                                           Options (constructorTagModifier, fieldLabelModifier, sumEncoding),                                            SumEncoding (TaggedObject),-                                           ToJSON (toJSON), defaultOptions, withObject, (.:), (.:?))+                                           ToJSON (toJSON), defaultOptions,+                                           withObject, (.:), (.:?)) import           Data.Aeson.TH            (deriveJSON, deriveToJSON) import qualified Data.ByteArray           as A (take) import           Data.ByteArray.HexString (toText)@@ -47,7 +49,7 @@ import           Data.Text                (Text) import qualified Data.Text                as T (dropEnd, unlines, unpack) import           Data.Text.Encoding       (encodeUtf8)-import           Lens.Micro               (over, _head)+import           Lens.Micro               (_head, over) import           Text.Parsec              (ParseError, char, choice, digit, eof,                                            lookAhead, many1, manyTill,                                            optionMaybe, parse, string, try,@@ -91,6 +93,11 @@   | SMNonPayable   deriving (Eq, Ord, Show) +$(deriveJSON (defaultOptions {+    sumEncoding = TaggedObject "stateMutability" "contents"+  , constructorTagModifier = fmap toLower . drop 2 })+    ''StateMutability)+ -- | Elementary contract interface item data Declaration = DConstructor     { conInputs :: [FunctionArg]@@ -109,6 +116,11 @@     , eveAnonymous :: Bool     -- ^ Event     }+    | DError+    { errName   :: Text+    , errInputs :: [FunctionArg]+    -- ^ Error+    }     | DFallback     { falPayable :: Bool     -- ^ Fallback function@@ -116,33 +128,44 @@     deriving Show  instance Eq Declaration where-    (DConstructor a) == (DConstructor b) = length a == length b+    (DConstructor a) == (DConstructor b)       = length a == length b     (DFunction a _ _ _) == (DFunction b _ _ _) = a == b-    (DEvent a _ _) == (DEvent b _ _) = a == b-    (DFallback _) == (DFallback _) = True-    (==) _ _ = False+    (DEvent a _ _) == (DEvent b _ _)           = a == b+    (DError a _) == (DError b _)               = a == b+    (DFallback _) == (DFallback _)             = True+    (==) _ _                                   = False  instance Ord Declaration where     compare (DConstructor a) (DConstructor b) = compare (length a) (length b)     compare (DFunction a _ _ _) (DFunction b _ _ _) = compare a b     compare (DEvent a _ _) (DEvent b _ _) = compare a b+    compare (DError a _) (DError b _) = compare a b     compare (DFallback _) (DFallback _) = EQ      compare DConstructor {} DFunction {} = LT     compare DConstructor {} DEvent {} = LT+    compare DConstructor {} DError {} = LT     compare DConstructor {} DFallback {} = LT      compare DFunction {} DConstructor {} = GT     compare DFunction {} DEvent {} = LT+    compare DFunction {} DError {} = LT     compare DFunction {} DFallback {} = LT      compare DEvent {} DConstructor {} = GT     compare DEvent {} DFunction {} = GT+    compare DEvent {} DError {} = LT     compare DEvent {} DFallback {} = LT +    compare DError {} DConstructor {} = GT+    compare DError {} DFunction {} = GT+    compare DError {} DEvent {} = GT+    compare DError {} DFallback {} = LT+     compare DFallback {} DConstructor {} = GT     compare DFallback {} DFunction {} = GT     compare DFallback {} DEvent {} = GT+    compare DFallback {} DError {} = GT  instance FromJSON Declaration where   parseJSON = withObject "Declaration" $ \o -> do@@ -151,6 +174,7 @@       "fallback" -> DFallback <$> o .: "payable"       "constructor" -> DConstructor <$> o .: "inputs"       "event" -> DEvent <$> o .: "name" <*> o .: "inputs" <*> o .: "anonymous"+      "error" -> DError <$> o .: "name" <*> o .: "inputs"       "function" -> DFunction <$> o .: "name" <*> parseSm o <*> o .: "inputs" <*> o .:? "outputs"       _ -> fail "value of 'type' not recognized"       where@@ -166,12 +190,6 @@        , fieldLabelModifier = over _head toLower . drop 3 })    ''Declaration) -$(deriveJSON (defaultOptions {-    sumEncoding = TaggedObject "stateMutability" "contents"-  , constructorTagModifier = fmap toLower . drop 2 })-    ''StateMutability)-- -- | Contract Abi is a list of method / event declarations newtype ContractAbi = ContractAbi { unAbi :: [Declaration] }   deriving (Eq, Ord)@@ -207,28 +225,23 @@         ["\t\t" <> methodId x <> " " <> signature x]     _ -> [] +funArgs :: [FunctionArg] -> Text+funArgs [] = ""+funArgs [x] = funArgType x+funArgs (x:xs) = case funArgComponents x of+  Nothing   -> funArgType x <> "," <> funArgs xs+  Just cmps -> case funArgType x of+      "tuple" -> "(" <> funArgs cmps <> ")," <> funArgs xs+      "tuple[]" -> "(" <> funArgs cmps <> ")[]," <> funArgs xs+      typ       -> error $ "Unexpected type " ++ T.unpack typ ++ " - expected tuple or tuple[]"+ -- | Take a signature by given decl, e.g. foo(uint,string) signature :: Declaration -> Text -signature (DConstructor inputs) = "(" <> args inputs <> ")"-  where-    args [] = ""-    args [x] = funArgType x-    args (x:xs) = case funArgComponents x of-      Nothing   -> funArgType x <> "," <> args xs-      Just cmps -> "(" <> args cmps <> ")," <> args xs-+signature (DConstructor inputs) = "(" <> funArgs inputs <> ")" signature (DFallback _) = "()"--signature (DFunction name _ inputs _) = name <> "(" <> args inputs <> ")"-  where-    args :: [FunctionArg] -> Text-    args [] = ""-    args [x] = funArgType x-    args (x:xs) = case funArgComponents x of-      Nothing   -> funArgType x <> "," <> args xs-      Just cmps -> "(" <> args cmps <> ")," <> args xs-+signature (DFunction name _ inputs _) = name <> "(" <> funArgs inputs <> ")"+signature (DError name inputs) = name <> "(" <> funArgs inputs <> ")" signature (DEvent name inputs _) = name <> "(" <> args inputs <> ")"   where     args :: [EventArg] -> Text@@ -329,8 +342,12 @@ parseSolidityFunctionArgType :: FunctionArg -> Either ParseError SolidityType parseSolidityFunctionArgType (FunctionArg _ typ mcmps) = case mcmps of   Nothing -> parse solidityTypeParser "Solidity" typ-  Just cmps -> SolidityTuple <$> mapM parseSolidityFunctionArgType cmps-+  Just cmps -> do+    tpl <- SolidityTuple <$> mapM parseSolidityFunctionArgType cmps+    case typ of+        "tuple"   -> return tpl+        "tuple[]" -> return $ SolidityArray tpl+        _         -> error $ "Unexpected type " ++ T.unpack typ ++ " - expected tuple or tuple[]"  parseSolidityEventArgType :: EventArg -> Either ParseError SolidityType parseSolidityEventArgType (EventArg _ typ _) = parse solidityTypeParser "Solidity" typ

@@ -1,4 +1,15 @@ {-# LANGUAGE OverloadedStrings #-}++-- |+-- Module      :  Data.Solidity.Test.AddressSpec+-- Copyright   :  Aleksandr Krupenkin 2016-2024+-- License     :  Apache-2.0+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  unportable+--+ module Data.Solidity.Test.AddressSpec where  import           Data.ByteString            (ByteString)

@@ -3,12 +3,23 @@ {-# LANGUAGE OverloadedLists   #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies      #-}+{-# LANGUAGE TypeOperators     #-} +-- |+-- Module      :  Data.Solidity.Test.EncodingSpec+-- Copyright   :  Aleksandr Krupenkin 2016-2024+-- License     :  Apache-2.0+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  unportable+--+ module Data.Solidity.Test.EncodingSpec where  import           Control.Exception          (evaluate) import           Data.Text                  (Text)-import           Data.Tuple.OneTuple        (OneTuple (..))+import           Data.Tuple.OneTuple import           Generics.SOP               (Generic, Rep) import           Test.Hspec 

@@ -1,4 +1,15 @@ {-# LANGUAGE DataKinds #-}++-- |+-- Module      :  Data.Solidity.Test.IntSpec+-- Copyright   :  Aleksandr Krupenkin 2016-2024+-- License     :  Apache-2.0+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  unportable+--+ module Data.Solidity.Test.IntSpec where  import           Test.Hspec

@@ -1,8 +1,20 @@ {-# LANGUAGE OverloadedStrings #-}++-- |+-- Module      :  Language.Solidity.Test.AbiSpec+-- Copyright   :  Aleksandr Krupenkin 2016-2024+-- License     :  Apache-2.0+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  unportable+--+ module Language.Solidity.Test.AbiSpec where   import           Data.Either           (isLeft)+import           Data.Text             (Text) import           Language.Solidity.Abi import           Test.Hspec @@ -21,40 +33,62 @@           let tupleFA = FunctionArg "order" "tuple" Nothing               eRes = parseSolidityFunctionArgType tupleFA           isLeft eRes `shouldBe` True-  describe "signature" $+  describe "signature" $ do     it "can generate signature for fillOrder" $ do-      let fillOrderDec = buildFillOrderDec-          expected = "fillOrder((address,address,address,address,uint256,uint256,uint256,uint256,uint256,uint256,bytes,bytes),uint256,bytes)"+      let expected = "fillOrder((address,address,address,address,uint256,uint256,uint256,uint256,uint256,uint256,bytes,bytes),uint256,bytes)"           sig = signature fillOrderDec       sig `shouldBe` expected-  describe "methodId" $+    it "can generate signature for fillManyOrders" $ do+      let expected = "fillManyOrders((address,address,address,address,uint256,uint256,uint256,uint256,uint256,uint256,bytes,bytes)[],uint256,bytes)"+          sig = signature fillManyOrdersDec+      sig `shouldBe` expected+  describe "methodId" $ do     it "can generate methodId for fillOrder" $ do-      let fillOrderDec = buildFillOrderDec-          expected = "0xb4be83d5"+      let expected = "0xb4be83d5"           mId = methodId fillOrderDec       mId `shouldBe` expected+    it "can generate methodId for fillManyOrders" $ do+      let expected = "0xd52e8a68"+          mId = methodId fillManyOrdersDec+      mId `shouldBe` expected -buildFillOrderDec :: Declaration-buildFillOrderDec = DFunction "fillOrder" False funInputs' funOutputs'+orderTupleComponents :: [(Text, Text)]+orderTupleComponents =+  [ ("makerAddress", "address")+  , ("takerAddress", "address")+  , ("feeRecipientAddress", "address")+  , ("senderAddress", "address")+  , ("makerAssetAmount", "uint256")+  , ("takerAssetAmount", "uint256")+  , ("makerFee", "uint256")+  , ("takerFee", "uint256")+  , ("expirationTimeSeconds", "uint256")+  , ("salt", "uint256")+  , ("makerAssetData", "bytes")+  , ("takerAssetData", "bytes")+  ]++fillOrderDec :: Declaration+fillOrderDec = DFunction "fillOrder" False funInputs' funOutputs'   where     funInputs' =-      [ makeTupleFuncArg ("order", "tuple") tupleComponents+      [ makeTupleFuncArg ("order", "tuple") orderTupleComponents       , makeBasicFuncArg ("takerAssetFillAmount", "uint256")       , makeBasicFuncArg ("signature", "bytes")       ]-    tupleComponents =-      [ ("makerAddress", "address")-      , ("takerAddress", "address")-      , ("feeRecipientAddress", "address")-      , ("senderAddress", "address")-      , ("makerAssetAmount", "uint256")-      , ("takerAssetAmount", "uint256")-      , ("makerFee", "uint256")-      , ("takerFee", "uint256")-      , ("expirationTimeSeconds", "uint256")-      , ("salt", "uint256")-      , ("makerAssetData",   "bytes")-      , ("takerAssetData",   "bytes")+    funOutputs' = Nothing+    makeBasicFuncArg (n,t) =+      FunctionArg n t Nothing+    makeTupleFuncArg (n,t) cmps =+      FunctionArg n t (Just $ map makeBasicFuncArg cmps)++fillManyOrdersDec :: Declaration+fillManyOrdersDec = DFunction "fillManyOrders" False funInputs' funOutputs'+  where+    funInputs' =+      [ makeTupleFuncArg ("orders", "tuple[]") orderTupleComponents+      , makeBasicFuncArg ("takerAssetFillAmount", "uint256")+      , makeBasicFuncArg ("signature", "bytes")       ]     funOutputs' = Nothing     makeBasicFuncArg (n,t) =

@@ -1,9 +1,9 @@ cabal-version: 1.12 name:          web3-solidity-version:       1.0.0.0+version:       1.0.1.0 license:       Apache-2.0 license-file:  LICENSE-copyright:     (c) Aleksandr Krupenkin 2016-2021+copyright:     (c) Aleksandr Krupenkin 2016-2024 maintainer:    mail@akru.me author:        Aleksandr Krupenkin homepage:      https://github.com/airalab/hs-web3#readme@@ -42,32 +42,32 @@     other-modules:    Paths_web3_solidity     default-language: Haskell2010     ghc-options:-        -funbox-strict-fields -Wduplicate-exports -Whi-shadowing-        -Widentities -Woverlapping-patterns -Wpartial-type-signatures+        -funbox-strict-fields -Wduplicate-exports -Widentities+        -Woverlapping-patterns -Wpartial-type-signatures         -Wunrecognised-pragmas -Wtyped-holes -Wincomplete-patterns         -Wincomplete-uni-patterns -Wmissing-fields -Wmissing-methods-        -Wmissing-exported-signatures -Wmissing-monadfail-instances-        -Wmissing-signatures -Wname-shadowing -Wunused-binds-        -Wunused-top-binds -Wunused-local-binds -Wunused-pattern-binds-        -Wunused-imports -Wunused-matches -Wunused-foralls -Wtabs+        -Wmissing-exported-signatures -Wmissing-signatures -Wname-shadowing+        -Wunused-binds -Wunused-top-binds -Wunused-local-binds+        -Wunused-pattern-binds -Wunused-imports -Wunused-matches+        -Wunused-foralls -Wtabs      build-depends:-        OneTuple >0.2 && <0.3,-        aeson >1.2 && <1.6,-        base >4.11 && <4.15,+        OneTuple >0.2 && <0.5,+        aeson >1.2 && <2.2,+        base >4.11 && <4.19,         basement >0.0 && <0.1,-        bytestring >0.10 && <0.11,+        bytestring >0.10 && <0.12,         cereal >0.5 && <0.6,         data-default >0.7 && <0.8,         generics-sop >0.3 && <0.6,-        memory >0.14 && <0.16,-        memory-hexstring ==1.0.*,+        memory >0.14 && <0.19,+        memory-hexstring >=1.0 && <1.1,         microlens >0.4 && <0.5,         parsec >3.1 && <3.2,         tagged >0.8 && <0.9,-        template-haskell >2.11 && <2.17,-        text >1.2 && <1.3,-        web3-crypto ==1.0.*+        template-haskell >2.11 && <2.21,+        text >1.2 && <2.1,+        web3-crypto >=1.0 && <1.1  test-suite tests     type:             exitcode-stdio-1.0@@ -98,34 +98,33 @@      default-language: Haskell2010     ghc-options:-        -funbox-strict-fields -Wduplicate-exports -Whi-shadowing-        -Widentities -Woverlapping-patterns -Wpartial-type-signatures+        -funbox-strict-fields -Wduplicate-exports -Widentities+        -Woverlapping-patterns -Wpartial-type-signatures         -Wunrecognised-pragmas -Wtyped-holes -Wincomplete-patterns         -Wincomplete-uni-patterns -Wmissing-fields -Wmissing-methods-        -Wmissing-exported-signatures -Wmissing-monadfail-instances-        -Wmissing-signatures -Wname-shadowing -Wunused-binds-        -Wunused-top-binds -Wunused-local-binds -Wunused-pattern-binds-        -Wunused-imports -Wunused-matches -Wunused-foralls -Wtabs -threaded-        -rtsopts -with-rtsopts=-N+        -Wmissing-exported-signatures -Wmissing-signatures -Wname-shadowing+        -Wunused-binds -Wunused-top-binds -Wunused-local-binds+        -Wunused-pattern-binds -Wunused-imports -Wunused-matches+        -Wunused-foralls -Wtabs -threaded -rtsopts -with-rtsopts=-N      build-depends:-        OneTuple >0.2 && <0.3,-        aeson >1.2 && <1.6,-        base >4.11 && <4.15,+        OneTuple >0.2 && <0.5,+        aeson >1.2 && <2.2,+        base >4.11 && <4.19,         basement >0.0 && <0.1,-        bytestring >0.10 && <0.11,+        bytestring >0.10 && <0.12,         cereal >0.5 && <0.6,         data-default >0.7 && <0.8,         generics-sop >0.3 && <0.6,-        hspec >=2.4.4 && <2.8,+        hspec >=2.4.4 && <2.12,         hspec-contrib >=0.4.0 && <0.6,-        hspec-discover >=2.4.4 && <2.8,+        hspec-discover >=2.4.4 && <2.12,         hspec-expectations >=0.8.2 && <0.9,-        memory >0.14 && <0.16,-        memory-hexstring ==1.0.*,+        memory >0.14 && <0.19,+        memory-hexstring >=1.0 && <1.1,         microlens >0.4 && <0.5,         parsec >3.1 && <3.2,         tagged >0.8 && <0.9,-        template-haskell >2.11 && <2.17,-        text >1.2 && <1.3,-        web3-crypto ==1.0.*+        template-haskell >2.11 && <2.21,+        text >1.2 && <2.1,+        web3-crypto >=1.0 && <1.1