packages feed

web3 0.3.4.0 → 0.4.0.0

raw patch · 15 files changed

+499/−250 lines, 15 files

Files

+ data/ERC20.json view
@@ -0,0 +1,1 @@+[{"constant":true,"inputs":[],"name":"name","outputs":[{"name":"","type":"string"}],"payable":false,"type":"function"},{"constant":false,"inputs":[{"name":"_spender","type":"address"},{"name":"_value","type":"uint256"}],"name":"approve","outputs":[{"name":"","type":"bool"}],"payable":false,"type":"function"},{"constant":true,"inputs":[],"name":"totalSupply","outputs":[{"name":"","type":"uint256"}],"payable":false,"type":"function"},{"constant":false,"inputs":[{"name":"_from","type":"address"},{"name":"_to","type":"address"},{"name":"_value","type":"uint256"}],"name":"transferFrom","outputs":[{"name":"","type":"bool"}],"payable":false,"type":"function"},{"constant":true,"inputs":[],"name":"decimals","outputs":[{"name":"","type":"uint8"}],"payable":false,"type":"function"},{"constant":false,"inputs":[],"name":"kill","outputs":[],"payable":false,"type":"function"},{"constant":false,"inputs":[{"name":"_owner","type":"address"}],"name":"delegate","outputs":[],"payable":false,"type":"function"},{"constant":true,"inputs":[{"name":"_owner","type":"address"}],"name":"balanceOf","outputs":[{"name":"","type":"uint256"}],"payable":false,"type":"function"},{"constant":true,"inputs":[],"name":"owner","outputs":[{"name":"","type":"address"}],"payable":false,"type":"function"},{"constant":true,"inputs":[],"name":"symbol","outputs":[{"name":"","type":"string"}],"payable":false,"type":"function"},{"constant":false,"inputs":[{"name":"_to","type":"address"},{"name":"_value","type":"uint256"}],"name":"transfer","outputs":[{"name":"","type":"bool"}],"payable":false,"type":"function"},{"constant":true,"inputs":[{"name":"_owner","type":"address"},{"name":"_spender","type":"address"}],"name":"allowance","outputs":[{"name":"","type":"uint256"}],"payable":false,"type":"function"},{"constant":false,"inputs":[{"name":"_spender","type":"address"}],"name":"unapprove","outputs":[],"payable":false,"type":"function"},{"inputs":[{"name":"_name","type":"string"},{"name":"_symbol","type":"string"},{"name":"_decimals","type":"uint8"},{"name":"_count","type":"uint256"}],"type":"constructor"},{"anonymous":false,"inputs":[{"indexed":true,"name":"_from","type":"address"},{"indexed":true,"name":"_to","type":"address"},{"indexed":false,"name":"_value","type":"uint256"}],"name":"Transfer","type":"event"},{"anonymous":false,"inputs":[{"indexed":true,"name":"_owner","type":"address"},{"indexed":true,"name":"_spender","type":"address"},{"indexed":false,"name":"_value","type":"uint256"}],"name":"Approval","type":"event"}]
− data/sample.json 
@@ -1,1 +0,0 @@-[{"constant":false,"inputs":[],"name":"runA1","outputs":[],"payable":false,"type":"function"},{"constant":false,"inputs":[{"name":"_s","type":"string"},{"name":"_x","type":"uint256"}],"name":"runA2","outputs":[],"payable":false,"type":"function"},{"anonymous":false,"inputs":[{"indexed":true,"name":"client","type":"address"},{"indexed":true,"name":"s","type":"uint256"}],"name":"Action1","type":"event"},{"anonymous":false,"inputs":[{"indexed":false,"name":"str","type":"string"},{"indexed":true,"name":"i","type":"uint256"}],"name":"Action2","type":"event"}]
− data/sample.sol 
@@ -1,13 +0,0 @@-pragma solidity ^0.4.2;--contract TestContract {-    event Action1(address indexed client, uint indexed s);-    event Action2(string str, uint indexed i);-    -    function runA1() {-        Action1(msg.sender, 10);-    }-    function runA2(string _s, uint _x) {-        Action2(_s, _x);-    }-}
src/Network/Ethereum/Web3.hs view
@@ -28,8 +28,7 @@   , Event(..)   , Method(..)   , nopay-  -- ** ABI encoding & data types-  , ABIEncoding(..)+  -- ** Ethereum data types   , BytesN(..)   , BytesD(..)   , Address@@ -37,9 +36,10 @@   , module Network.Ethereum.Unit   ) where +import Network.Ethereum.Web3.Encoding.Bytes+import Network.Ethereum.Web3.Encoding.Tuple import Network.Ethereum.Web3.Contract import Network.Ethereum.Web3.Encoding import Network.Ethereum.Web3.Address import Network.Ethereum.Web3.Types-import Network.Ethereum.Web3.Bytes import Network.Ethereum.Unit
− src/Network/Ethereum/Web3/Bytes.hs 
@@ -1,72 +0,0 @@-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE DataKinds      #-}--- |--- Module      :  Network.Ethereum.Web3.Bytes--- Copyright   :  Alexander Krupenkin 2016--- License     :  BSD3------ Maintainer  :  mail@akru.me--- Stability   :  experimental--- Portability :  noportable------ The type bytes<M> support.----module Network.Ethereum.Web3.Bytes (-    BytesN(..)-  , BytesD(..)-  ) where--import qualified Data.ByteString.Base16 as BS16 (decode, encode)-import qualified Data.Attoparsec.Text   as P-import qualified Data.Text.Lazy.Builder as B-import qualified Data.Text.Encoding     as T-import qualified Data.Text              as T-import qualified Data.ByteArray         as BA-import Network.Ethereum.Web3.EncodingUtils-import Network.Ethereum.Web3.Encoding-import GHC.TypeLits (KnownNat, Nat, natVal)-import Data.ByteArray (Bytes)-import Data.Monoid ((<>))--import Debug.Trace---- | Fixed length byte array-newtype BytesN (n :: Nat) = BytesN { unBytesN :: Bytes }-  deriving (Eq, Ord)--update :: BytesN a -> Bytes -> BytesN a-update _ a = BytesN a--instance KnownNat n => ABIEncoding (BytesN n) where-    toDataBuilder (BytesN bytes) = bytesBuilder bytes-    fromDataParser = do-        let result   = undefined :: KnownNat n => BytesN n-            len      = fromIntegral (natVal result)-        bytesString <- T.take (len * 2) <$> P.take 64-        return (update result (bytesDecode bytesString))--instance KnownNat n => Show (BytesN n) where-    show = show . BS16.encode . BA.convert . unBytesN--bytesBuilder :: Bytes -> B.Builder-bytesBuilder = alignL . B.fromText . T.decodeUtf8-             . BS16.encode . BA.convert--bytesDecode :: T.Text -> Bytes-bytesDecode = BA.convert . fst . BS16.decode . T.encodeUtf8---- | Dynamic length byte array-newtype BytesD = BytesD { unBytesD :: Bytes }-  deriving (Eq, Ord)--instance ABIEncoding BytesD where-    toDataBuilder (BytesD bytes) = int256HexBuilder (BA.length bytes)-                                <> bytesBuilder bytes-    fromDataParser = do-        len <- int256HexParser-        if (len :: Integer) > fromIntegral (maxBound :: Int)-        then fail "Bytes length over bound!"-        else (BytesD . bytesDecode) <$> P.take (fromIntegral len * 2)--instance Show BytesD where-    show = show . BS16.encode . BA.convert . unBytesD
src/Network/Ethereum/Web3/Contract.hs view
@@ -102,7 +102,8 @@     call :: ABIEncoding b => Address -> CallMode -> a -> Web3 b     call = _call -_sendTransaction :: (Method a, Unit b) => Address -> b -> a -> Web3 TxHash+_sendTransaction :: (Method a, Unit b)+                 => Address -> b -> a -> Web3 TxHash _sendTransaction to value dat = do     primeAddress <- head <$> eth_accounts     eth_sendTransaction (txdata primeAddress $ Just $ toData dat)@@ -112,11 +113,14 @@ -- TODO: Correct dynamic type parsing _call :: (Method a, ABIEncoding b)       => Address -> CallMode -> a -> Web3 b-_call to mode dat = do res <- eth_call txdata mode-                       case fromData (T.drop 2 res) of-                           Nothing -> fail "Unable to parse result"-                           Just x -> return x-  where txdata = Call Nothing to Nothing Nothing Nothing (Just (toData dat))+_call to mode dat = do+    res <- eth_call txdata mode+    case fromData (T.drop 2 res) of+        Nothing -> fail $+            "Unable to parse result on `" ++ T.unpack res ++ "`"+        Just x -> return x+  where+    txdata = Call Nothing to Nothing Nothing Nothing (Just (toData dat))  -- | Zero value is used to send transaction without money nopay :: Wei
src/Network/Ethereum/Web3/Encoding.hs view
@@ -17,8 +17,8 @@ import qualified Data.Attoparsec.Text          as P import qualified Data.Text.Lazy                as LT import qualified Data.Text                     as T+import Network.Ethereum.Web3.Encoding.Internal import Network.Ethereum.Web3.Address (Address)-import Network.Ethereum.Web3.EncodingUtils import Data.Monoid ((<>)) import Data.Text (Text)
+ src/Network/Ethereum/Web3/Encoding/Bytes.hs view
@@ -0,0 +1,80 @@+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE DataKinds      #-}+-- |+-- Module      :  Network.Ethereum.Web3.Encoding.Bytes+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  noportable+--+-- The type bytes<M> support.+--+module Network.Ethereum.Web3.Encoding.Bytes (+    BytesN(..)+  , BytesD(..)+  ) where++import qualified Data.ByteString.Base16 as BS16 (decode, encode)+import qualified Data.Attoparsec.Text   as P+import qualified Data.Text.Lazy.Builder as B+import qualified Data.Text.Encoding     as T+import qualified Data.Text              as T+import qualified Data.ByteArray         as BA+import Network.Ethereum.Web3.Encoding.Internal+import Network.Ethereum.Web3.Encoding+import GHC.TypeLits (KnownNat, Nat, natVal)+import Data.ByteArray (Bytes)+import Data.Monoid ((<>))++import Debug.Trace++-- | Fixed length byte array+newtype BytesN (n :: Nat) = BytesN { unBytesN :: Bytes }+  deriving (Eq, Ord)++update :: BytesN a -> Bytes -> BytesN a+update _ a = BytesN a++instance KnownNat n => EncodingType (BytesN n) where+    typeName  = const "bytes[N]"+    isDynamic = const False++instance KnownNat n => ABIEncoding (BytesN n) where+    toDataBuilder (BytesN bytes) = bytesBuilder bytes+    fromDataParser = do+        let result   = undefined :: KnownNat n => BytesN n+            len      = fromIntegral (natVal result)+        bytesString <- T.take (len * 2) <$> P.take 64+        return (update result (bytesDecode bytesString))++instance KnownNat n => Show (BytesN n) where+    show = show . BS16.encode . BA.convert . unBytesN++bytesBuilder :: Bytes -> B.Builder+bytesBuilder = alignL . B.fromText . T.decodeUtf8+             . BS16.encode . BA.convert++bytesDecode :: T.Text -> Bytes+bytesDecode = BA.convert . fst . BS16.decode . T.encodeUtf8++-- | Dynamic length byte array+newtype BytesD = BytesD { unBytesD :: Bytes }+  deriving (Eq, Ord)++instance EncodingType BytesD where+    typeName  = const "bytes[]"+    isDynamic = const True++instance ABIEncoding BytesD where+    toDataBuilder (BytesD bytes) = int256HexBuilder (BA.length bytes)+                                <> bytesBuilder bytes+    fromDataParser = do+        len <- int256HexParser+        if (len :: Integer) > fromIntegral (maxBound :: Int)+        then fail "Bytes length over bound!"+        else (BytesD . bytesDecode) <$> P.take (fromIntegral len * 2)++instance Show BytesD where+    show = show . BS16.encode . BA.convert . unBytesD
+ src/Network/Ethereum/Web3/Encoding/Internal.hs view
@@ -0,0 +1,99 @@+-- |+-- Module      :  Network.Ethereum.Web3.Encoding.Internal+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  portable+--+-- ABI encoding internal function and types.+--+module Network.Ethereum.Web3.Encoding.Internal where++import Data.Text.Lazy.Builder (Builder, toLazyText, fromText, fromLazyText)+import qualified Data.ByteString.Base16        as BS16 (decode, encode)+import qualified Data.Attoparsec.Text          as P+import qualified Data.Text.Lazy                as LT+import qualified Data.Text                     as T+import qualified Data.Text.Read                as R+import Data.Text.Encoding (encodeUtf8, decodeUtf8)+import Network.Ethereum.Web3.Address (Address)+import Data.Attoparsec.Text.Lazy (Parser)+import Data.Text.Lazy.Builder.Int as B+import Language.Haskell.TH+import Data.Monoid ((<>))+import Data.Text (Text)+import Data.Bits (Bits)++class EncodingType a where+    typeName :: a -> String+    isDynamic :: a -> Bool++instance EncodingType Bool where+    typeName  = const "bool"+    isDynamic = const False++instance EncodingType Integer where+    typeName  = const "int"+    isDynamic = const False++instance EncodingType Int where+    typeName  = const "int"+    isDynamic = const False++instance EncodingType Word where+    typeName  = const "uint"+    isDynamic = const False++instance EncodingType Text where+    typeName  = const "string"+    isDynamic = const True++instance EncodingType Address where+    typeName  = const "address"+    isDynamic = const False++instance EncodingType a => EncodingType [a] where+    typeName  = const "[]"+    isDynamic = const True++-- | Make 256bit alignment; lazy (left, right)+align :: Builder -> (Builder, Builder)+align v = (v <> zeros, zeros <> v)+  where zerosLen | LT.length s `mod` 64 == 0 = 0+                 | otherwise = 64 - (LT.length s `mod` 64)+        zeros = fromLazyText (LT.replicate zerosLen "0")+        s = toLazyText v++-- | Left/Right specialized alignment+alignL, alignR :: Builder -> Builder+{-# INLINE alignL #-}+alignL = fst . align+{-# INLINE alignR #-}+alignR = snd . align++int256HexBuilder :: Integral a => a -> Builder+int256HexBuilder x | x < 0 = int256HexBuilder (2^256 + fromIntegral x)+                   | otherwise = alignR (B.hexadecimal x)++int256HexParser :: (Bits a, Integral a) => Parser a+int256HexParser = do+    hex <- P.take 64+    case R.hexadecimal hex of+        Right (v, "") -> return v+        _ -> fail ("Broken hexadecimal: `" ++ T.unpack hex ++ "`")++textBuilder :: Text -> Builder+textBuilder s = int256HexBuilder (T.length hex `div` 2)+             <> alignL (fromText hex)+  where textToHex = decodeUtf8 . BS16.encode . encodeUtf8+        hex = textToHex s++textParser :: Parser Text+textParser = do+    len <- int256HexParser+    let zeroBytes = 32 - (len `mod` 32)+    str <- P.take (len * 2) <* P.take (zeroBytes * 2)+    return (hexToText str)+  where hexToText = decodeUtf8 . fst . BS16.decode . encodeUtf8
+ src/Network/Ethereum/Web3/Encoding/Tuple.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE TemplateHaskell #-}+-- |+-- Module      :  Network.Ethereum.Web3.Encoding.Tuple+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  portable+--+-- ABIEncoding tuple instances.+--+module Network.Ethereum.Web3.Encoding.Tuple (Singleton(..)) where++import Network.Ethereum.Web3.Encoding.Internal+import Network.Ethereum.Web3.Encoding.TupleTH+import Network.Ethereum.Web3.Encoding++-- | Singleton parameter instance+newtype Singleton a = Singleton { unSingleton :: a }++instance (EncodingType a, ABIEncoding a) => ABIEncoding (Singleton a) where+    toDataBuilder = _serialize (1, []) . unSingleton+    fromDataParser = Singleton <$> (withParser sParser >>= dParser)+      where withParser f = f undefined++-- | Tuple instances from 2 to 15 params+$(mkTupleInst 2)+$(mkTupleInst 3)+$(mkTupleInst 4)+$(mkTupleInst 5)+$(mkTupleInst 6)+$(mkTupleInst 7)+$(mkTupleInst 8)+$(mkTupleInst 9)+$(mkTupleInst 10)+$(mkTupleInst 11)+$(mkTupleInst 12)+$(mkTupleInst 13)+$(mkTupleInst 14)+$(mkTupleInst 15)
+ src/Network/Ethereum/Web3/Encoding/TupleTH.hs view
@@ -0,0 +1,152 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE QuasiQuotes     #-}+-- |+-- Module      :  Network.Ethereum.Web3.Encoding.TupleTH+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  portable+--+-- Tuple ABI encoding instance TH generator.+--+module Network.Ethereum.Web3.Encoding.TupleTH (+    mkTupleInst+  , ABIData(..)+  , sParser+  , dParser+  ) where++import Data.Text.Lazy.Builder (toLazyText, Builder)+import Network.Ethereum.Web3.Encoding.Internal+import qualified Data.Attoparsec.Text as P+import qualified Data.Text.Lazy       as LT+import Network.Ethereum.Web3.Encoding+import Data.Attoparsec.Text (Parser)+import Language.Haskell.TH++-- | Argument offset calculator+offset :: Int+       -- ^ Count of arguments+       -> [Builder]+       -- ^ Previous dynamic arguments+       -> Int+       -- ^ Offset+offset totalArgs args = headerOffset + dataOffset+  where+    headerOffset = totalArgs * 32+    dataOffset   = builderLen (mconcat args)+    builderLen   = fromIntegral . (`div` 2) . LT.length . toLazyText++-- | ABI data multiparam internal serializer+class ABIData a where+    _serialize :: (Int, [(Builder, Builder)]) -> a+    -- ^ Serialize with accumulator:+    -- pair of argument count and list of pair header and+    -- data part (for dynamic arguments)++instance (EncodingType b, ABIEncoding b, ABIData a) => ABIData (b -> a) where+    _serialize (n, l) x+        | isDynamic x = _serialize (n, (toDataBuilder dynOffset, toDataBuilder x) : l)+        | otherwise   = _serialize (n, (toDataBuilder x        , mempty) : l)+      where dynOffset = offset n (fmap snd l)++instance ABIData Builder where+    _serialize = uncurry mappend . mconcat . reverse . snd++-- | Static argument parser+sParser :: (EncodingType a, ABIEncoding a) => a -> Parser a+sParser x | isDynamic x = P.take 64 >> return undefined+          | otherwise   = fromDataParser++-- | Dynamic argument parser+dParser :: (EncodingType a, ABIEncoding a) => a -> Parser a+dParser x | isDynamic x = fromDataParser+          | otherwise   = return x++-- | Generator for tupleP{N} function signature+mkTuplePType :: Int -> DecQ+mkTuplePType n = do+    vars <- sequence (replicate n $ newName "t")+    let varsT      = fmap varT vars+        contextT   = fmap (appT [t|ABIEncoding|]) varsT+                  ++ fmap (appT [t|EncodingType|]) varsT+        varsTupleT = foldl appT (tupleT n) varsT+    sigD (mkName $ "tupleP" ++ show n)+         (forallT [] (cxt contextT) [t|Parser $(varsTupleT)|])++-- | Generator for tupleP{N} function+mkTupleP :: Int -> DecQ+mkTupleP n = do+    vars <- sequence (replicate n $ newName "t")+    funD (mkName $ "tupleP" ++ show n) $ pure $+        clause []+               (normalB [|$(varE withPN) $(varE staticPN) >>= $(varE dynamicPN)|])+               (decs vars)+  where+    withPN    = mkName "withParser"+    staticPN  = mkName "staticParser"+    dynamicPN = mkName "dynamicParser"+    fun       = mkName "f"+    decs vars = [ withPFun, staticPFun vars, dynamicPFun vars ]++    withPFun  = funD withPN $ pure $+        clause [varP fun]+            (normalB [|$(varE fun) $(tupE (replicate n [|undefined|]))|]) []++    staticPFun vars = funD staticPN $ pure $+        clause [tupP $ fmap varP vars]+            (normalB (mkAppSeq (eTupleE n : fmap (\x -> [|sParser $(varE x)|]) vars))) []++    dynamicPFun vars = funD dynamicPN $ pure $+        clause [tupP $ fmap varP vars]+            (normalB (mkAppSeq (eTupleE n : fmap (\x -> [|dParser $(varE x)|]) vars))) []++mkAppSeq :: [ExpQ] -> ExpQ+mkAppSeq = infixApps . dollarFirst . sparse+  where sparse [x] = [x]+        sparse (x : xs) = x : [|(<*>)|] : sparse xs+        dollarFirst (x : _ : xs) = x : [|(<$>)|] : xs+        infixApps (x : xs) = go x xs+        go acc [] = acc+        go acc (f : x : xs) = go (infixApp acc f x) xs++eTupleE :: Int -> ExpQ+eTupleE 2  = [|(,)|]+eTupleE 3  = [|(,,)|]+eTupleE 4  = [|(,,,)|]+eTupleE 5  = [|(,,,,)|]+eTupleE 6  = [|(,,,,,)|]+eTupleE 7  = [|(,,,,,,)|]+eTupleE 8  = [|(,,,,,,,)|]+eTupleE 9  = [|(,,,,,,,,)|]+eTupleE 10 = [|(,,,,,,,,,)|]+eTupleE 11 = [|(,,,,,,,,,,)|]+eTupleE 12 = [|(,,,,,,,,,,,)|]+eTupleE 13 = [|(,,,,,,,,,,,,)|]+eTupleE 14 = [|(,,,,,,,,,,,,,)|]+eTupleE 15 = [|(,,,,,,,,,,,,,,)|]+eTupleE _ = error "Unsupported empty tuple"++mkEncodingInst :: Int -> DecQ+mkEncodingInst n = do+    vars <- sequence (replicate n $ newName "t")+    let varsT      = fmap varT vars+        contextT   = fmap (appT [t|ABIEncoding|]) varsT+                  ++ fmap (appT [t|EncodingType|]) varsT+        varsTupleT = foldl appT (tupleT n) varsT+    instanceD (cxt contextT) (appT [t|ABIEncoding|] varsTupleT)+      [ funD (mkName "toDataBuilder") [+            clause [tupP (fmap varP vars)]+                (normalB (appsE ([|_serialize (n, [])|] : fmap varE vars))) [] ]+      , funD (mkName "fromDataParser") [+            clause [] (normalB $ varE $ mkName $ "tupleP" ++ show n) [] ]+      ]++-- | Make a ABIEncoding tuple instance with given count of arguments+mkTupleInst :: Int -> Q [Dec]+mkTupleInst n = sequence $+  [ mkTuplePType n+  , mkTupleP n+  , mkEncodingInst n ]
− src/Network/Ethereum/Web3/EncodingUtils.hs 
@@ -1,64 +0,0 @@--- |--- Module      :  Network.Ethereum.Web3.EncodingUtils--- Copyright   :  Alexander Krupenkin 2016--- License     :  BSD3------ Maintainer  :  mail@akru.me--- Stability   :  experimental--- Portability :  portable------ ABI encoding functions.----module Network.Ethereum.Web3.EncodingUtils where--import Data.Text.Lazy.Builder (Builder, toLazyText, fromText, fromLazyText)-import qualified Data.ByteString.Base16        as BS16 (decode, encode)-import qualified Data.Attoparsec.Text          as P-import qualified Data.Text.Lazy                as LT-import qualified Data.Text                     as T-import qualified Data.Text.Read                as R-import Data.Text.Encoding (encodeUtf8, decodeUtf8)-import Data.Attoparsec.Text.Lazy (Parser)-import Data.Text.Lazy.Builder.Int as B-import Data.Monoid ((<>))-import Data.Text (Text)-import Data.Bits (Bits)---- | Make 256bit aligment; lazy (left, right)-align :: Builder -> (Builder, Builder)-align v = (v <> zeros, zeros <> v)-  where zerosLen | LT.length s `mod` 64 == 0 = 0-                 | otherwise = 64 - (LT.length s `mod` 64)-        zeros = fromLazyText (LT.replicate zerosLen "0")-        s = toLazyText v--alignL, alignR :: Builder -> Builder-{-# INLINE alignL #-}-alignL = fst . align-{-# INLINE alignR #-}-alignR = snd . align--int256HexBuilder :: Integral a => a -> Builder-int256HexBuilder x | x < 0 = int256HexBuilder (2^256 + fromIntegral x)-                   | otherwise = alignR (B.hexadecimal x)--int256HexParser :: (Bits a, Integral a) => Parser a-int256HexParser = do-    hex <- P.take 64-    case R.hexadecimal hex of-        Right (v, "") -> return v-        _ -> fail ("Broken hexadecimal: `" ++ T.unpack hex ++ "`")--textBuilder :: Text -> Builder-textBuilder s = int256HexBuilder (T.length hex `div` 2)-             <> alignL (fromText hex)-  where textToHex = decodeUtf8 . BS16.encode . encodeUtf8-        hex = textToHex s--textParser :: Parser Text-textParser = do-    len <- int256HexParser-    let zeroBytes = 32 - (len `mod` 32)-    str <- P.take (len * 2) <* P.take (zeroBytes * 2)-    return (hexToText str)-  where hexToText = decodeUtf8 . fst . BS16.decode . encodeUtf8
src/Network/Ethereum/Web3/TH.hs view
@@ -24,26 +24,41 @@ --   where wait = threadDelay 1000000 >> wait -- @ ---module Network.Ethereum.Web3.TH (abi, abiFrom) where+module Network.Ethereum.Web3.TH (+  -- ** Quasiquoter's+    abi+  , abiFrom+  -- ** Used by TH data types+  , Bytes+  , Text+  , Singleton(..)+  , ABIEncoding(..)+  ) where  import qualified Data.Text.Lazy.Encoding as LT import qualified Data.Text.Lazy.Builder  as B import qualified Data.Text.Lazy          as LT import qualified Data.Attoparsec.Text    as P import qualified Data.Text               as T+ import Network.Ethereum.Web3.Address (Address)+import Network.Ethereum.Web3.Encoding.Tuple+import Network.Ethereum.Web3.Encoding import Network.Ethereum.Web3.Internal import Network.Ethereum.Web3.Contract import Network.Ethereum.Web3.JsonAbi import Network.Ethereum.Web3.Types+import Network.Ethereum.Unit+ import Data.Text (Text, isPrefixOf) import Data.List (groupBy, sortBy) import Data.Monoid (mconcat, (<>))+import Data.ByteArray (Bytes)+import Data.Aeson+ import Language.Haskell.TH.Quote import Language.Haskell.TH.Lib import Language.Haskell.TH-import Control.Arrow-import Data.Aeson  -- | Read contract ABI from file abiFrom :: QuasiQuoter@@ -108,58 +123,48 @@ isDynType x | T.any (== '[') x = True             | otherwise        = False --- | ABI encoding generator-abiEncodingParse :: [(Text, Name)] -> [StmtQ]-abiEncodingParse vars = fmap parseSta vars-                     ++ fmap (parseVar . snd) dynVars-  where dynVars = filter (isDynType . fst) vars-        parseSta (t, v) | isDynType t = noBindS [|P.take 64|]-                        | otherwise   = parseVar v-        parseVar v = bindS (varP v) [|fromDataParser|]- eventEncodigD :: Name -> [EventArg] -> [DecQ]-eventEncodigD eventName args = [ funD' (mkName "toDataBuilder")  [] toDataB-                               , funD' (mkName "fromDataParser") [] fromDataP ]-  where toDataB = [|error "Event to data conversion isn't available!"|]-        indexed = map (eveArgType &&& eveArgIndexed) args-        genVar (a, b)   = do v <- newName "t"-                             return (b, (a, v))-        parseArg (_, v) = bindS (varP v) [|fromDataParser|]-        fromDataP  = do-            vars <- mapM genVar indexed-            let indexedVars   = [v | (ix, v) <- vars, ix]-                unindexedVars = [v | (ix, v) <- vars, not ix]-                freeVars      = [varE v | (_, (_, v)) <- vars]-            doE $ fmap parseArg indexedVars-               ++ abiEncodingParse unindexedVars-               ++ [noBindS [|return $(appsE (conE eventName : freeVars))|]]+eventEncodigD eventName args =+    [ funD' (mkName "toDataBuilder")  []+        [|error "Event to data conversion isn't available!"|]+    , funD' (mkName "fromDataParser") [] fromDataP ]+  where+    indexed = map eveArgIndexed args+    newVars = sequence $ replicate (length args) (newName "t") -genABIHeader :: [(Text, Name)] -> [ExpQ]-genABIHeader vars = fmap go offsetVars-  where offsetVars :: [((Text, Name), Int)]-        offsetVars = zip vars (fmap ((32 *) . (length vars +)) [0..])-        go ((typ, v), o) | isDynType typ = [|toDataBuilder (o :: Int)|]-                         | otherwise     = [|toDataBuilder $(varE v)|]+    parseArg v = bindS (varP v) [|fromDataParser|] -genABIData :: [(Text, Name)] -> [ExpQ]-genABIData = fmap (\(_, v) -> [|toDataBuilder $(varE v)|])+    parseData []   = []+    parseData [v]  = pure $ bindS (varP v) [|unSingleton <$> fromDataParser|]+    parseData vars = pure $ bindS (tupP (varP <$> vars)) [|fromDataParser|] -funEncodigD :: Name -> [FunctionArg] -> String -> [DecQ]-funEncodigD funName args ident =+    fromDataP = do+        vars <- zip indexed <$> newVars+        let ixVars   = [v | (isIndexed, v) <- vars, isIndexed]+            noIxVars = [v | (isIndexed, v) <- vars, not isIndexed]+            expVars  = [varE v | (_, v) <- vars]+        doE $ fmap parseArg ixVars+           ++ parseData noIxVars+           ++ [noBindS [|return $(appsE (conE eventName : expVars))|]]++funEncodigD :: Name -> Int -> String -> [DecQ]+funEncodigD funName paramLen ident =     [ funDtoDataB-    , funD' (mkName "fromDataParser") [] fromDataP ]-  where fromDataP = [|error "Function from data conversion isn't available!"|]-        funDtoDataB = do-            vars <- sequence $ replicate (length args) (newName "t")+    , funD' (mkName "fromDataParser") []+        [|error "Function from data conversion isn't available!"|] ]+  where+    newVars = sequence $ replicate paramLen (newName "t")+    sVar    = mkName "a"+    funDtoDataB+        | paramLen == 0 = funD' (mkName "toDataBuilder") [conP funName []] [|ident|]+        | paramLen == 1 = funD' (mkName "toDataBuilder")+                            [conP funName [varP sVar]]+                                [|ident <> toDataBuilder (Singleton $(varE sVar))|]+        | otherwise = do+            vars <- newVars             funD' (mkName "toDataBuilder")-                  [conP funName $ fmap varP vars]-                  (toDataB $ zip argTypes vars)-        argTypes  = fmap funArgType args-        toDataB vars = do-            let dynamicVars = filter (isDynType . fst) vars-            appE [|mconcat|] $-                listE $ [|B.fromText ident|]-                      : genABIHeader vars ++ genABIData dynamicVars+              [conP funName $ fmap varP vars]+              [|ident <> toDataBuilder $(tupE $ fmap varE vars)|]  eventFilterD :: String -> [DecQ] eventFilterD topic0 = let addr = mkName "a" in@@ -171,32 +176,46 @@      |]   ] -{-- - TODO- --funTypeWrapper :: Name -> [FunctionArg] -> Maybe [FunctionArg] -> DecQ-funTypeWrapper funName args result = sigD funName funType+funWrapper :: Bool+           -- ^ Is constant?+           -> Name+           -- ^ Function name+           -> Name+           -- ^ Function data name+           -> [FunctionArg]+           -- ^ Parameters+           -> Maybe [FunctionArg]+           -- ^ Results+           -> Q [Dec]+funWrapper c name dname args result = do+    a : b : vars <- sequence $ replicate (length args + 2) (newName "t")+    let params = appsE $ (conE dname) : fmap varE vars++    sequence $ case c of+        True ->+          [ sigD name $ arrowing $ [t|Address|] : inputT ++ [outputT]+          , funD' name (varP <$> a : vars) $+              case result of+                Just [_] -> [|unSingleton <$> call $(varE a) Latest $(params)|]+                _        -> [|call $(varE a) Latest $(params)|]+          ]++        False ->+          [ sigD name $ [t|Unit $(varT b) =>+                            $(arrowing $ [t|Address|] : varT b : inputT ++ [[t|Web3 TxHash|]])+                          |]+          , funD' name (varP <$> a : b : vars) $+                [|sendTx $(varE a) $(varE b) $(params)|] ]   where-    funType = foldl appT [t|Address|] $ arrowing (inputT ++ [outputT])-    arrowing= concat . zipWith (\a b -> [a, b]) (repeat arrowT)+    arrowing [x]  = x+    arrowing (x : xs) = [t|$x -> $(arrowing xs)|]     inputT  = fmap (typeQ . funArgType) args     outputT = case result of         Nothing  -> [t|Web3 ()|]         Just [x] -> [t|Web3 $(typeQ $ funArgType x)|]         Just xs  -> let outs = fmap (typeQ . funArgType) xs                     in  [t|Web3 $(foldl appT (tupleT (length xs)) outs)|]--} -funWrapper :: Bool -> Name -> Name -> [FunctionArg] -> DecQ-funWrapper c name dname args = do-    (a : b : vars) <- sequence $ replicate (length args + 2) (newName "t")-    let params = appsE ((conE dname) : fmap varE vars)-    case c of-        True  -> funD' name (fmap varP (a : vars)) $-            [|call $(varE a) Latest $(params)|]-        False -> funD' name (fmap varP (a : b : vars)) $-            [|sendTx $(varE a) $(varE b) $(params)|]- -- | Event declarations maker mkEvent :: Declaration -> Q [Dec] mkEvent eve@(DEvent name inputs _) = sequence $@@ -212,14 +231,13 @@  -- | Method delcarations maker mkFun :: Declaration -> Q [Dec]-mkFun fun@(DFunction name constant inputs outputs) = do-    sequence $+mkFun fun@(DFunction name constant inputs outputs) = (++)+  <$> funWrapper constant funName dataName inputs outputs+  <*> sequence         [ dataD' dataName (normalC dataName bangInput) derivingD-        , instanceD' dataName encodingT (funEncodigD dataName inputs mIdent)-        , instanceD' dataName methodT []-        -- , funTypeWrapper funName inputs outputs-        , funWrapper constant funName dataName inputs-        ]+        , instanceD' dataName encodingT+            (funEncodigD dataName (length inputs) mIdent)+        , instanceD' dataName methodT [] ]   where mIdent    = T.unpack (methodId fun)         dataName  = mkName (toUpperFirst (T.unpack $ name <> "Data"))         funName   = mkName (toLowerFirst (T.unpack name))
test/Spec.hs view
@@ -3,21 +3,24 @@ {-# LANGUAGE DataKinds         #-} module Main where -import Network.Ethereum.Web3.Address (fromText) import Network.Ethereum.Web3.TH import Network.Ethereum.Web3--import Control.Concurrent (threadDelay)-import Data.ByteArray (Bytes)-import Data.Text (Text)+import Data.Text (unpack)+import Text.Printf -[abiFrom|data/sample.json|]+[abiFrom|data/ERC20.json|]  main :: IO () main = do     putStrLn ""-    putStrLn [abiFrom|data/sample.json|]-    -- runWeb3 $ event addr (\(Action2 x y) -> print x >> print y >> return TerminateEvent)-    -- threadDelay 100000000-    -- return ()-  where Right addr = fromText "0x19EE7966474b31225F71Ef8e36A71378a58a20E1"+    putStrLn [abiFrom|data/ERC20.json|]+{-+    Right s <- runWeb3 $ do+        n <- name token+        s <- symbol token+        d <- decimals token+        return $ printf "Token %s with symbol %s and decimals %d"+                        (unpack n) (unpack s) d+    putStrLn s+  where token = "0x237D60A8b41aFD2a335305ed458B609D7667D789"+-}
web3.cabal view
@@ -1,5 +1,5 @@ name:                web3-version:             0.3.4.0+version:             0.4.0.0 synopsis:            Ethereum API for Haskell description:         Web3 is a Haskell client library for Ethereum homepage:            https://github.com/airalab/hs-web3#readme@@ -14,8 +14,7 @@  extra-source-files:   README.md-  data/sample.json-  data/sample.sol+  data/ERC20.json  source-repository head   type:     git@@ -28,14 +27,16 @@                      , Network.Ethereum.Web3.TH                      , Network.Ethereum.Web3.Api                      , Network.Ethereum.Web3.Types-                     , Network.Ethereum.Web3.Bytes                      , Network.Ethereum.Web3.Address                      , Network.Ethereum.Web3.JsonAbi                      , Network.Ethereum.Web3.Encoding                      , Network.Ethereum.Web3.Contract+                     , Network.Ethereum.Web3.Encoding.Bytes+                     , Network.Ethereum.Web3.Encoding.Tuple   other-modules:       Network.Ethereum.Web3.JsonRpc                      , Network.Ethereum.Web3.Internal-                     , Network.Ethereum.Web3.EncodingUtils+                     , Network.Ethereum.Web3.Encoding.TupleTH+                     , Network.Ethereum.Web3.Encoding.Internal   build-depends:       base >4.8 && <4.11                      , data-default-class                      , base16-bytestring