packages feed

web3 (empty) → 0.3.2.0

raw patch · 20 files changed

+1522/−0 lines, 20 filesdep +aesondep +attoparsecdep +basesetup-changed

Dependencies added: aeson, attoparsec, base, base16-bytestring, binary, bytestring, cryptonite, data-default-class, http-client, http-client-tls, memory, mtl, template-haskell, text, transformers, vector, web3

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Alexander Krupenkin (c) 2016++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Alexander Krupenkin nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,63 @@+## Ethereum Haskell API++This is the Ethereum compatible Haskell API which implements the [Generic JSON RPC](https://github.com/ethereum/wiki/wiki/JSON-RPC) spec.++[![Build Status](https://travis-ci.org/airalab/hs-web3.svg?branch=master)](https://travis-ci.org/airalab/hs-web3)+[![Build status](https://ci.appveyor.com/api/projects/status/ly40a39ojsxpv24w?svg=true)](https://ci.appveyor.com/project/akru/hs-web3)+![Hackage](https://img.shields.io/hackage/v/web3.svg)+![Hackage Dependencies](https://img.shields.io/hackage-deps/v/web3.svg)+![Haskell Programming Language](https://img.shields.io/badge/language-Haskell-blue.svg)+![BSD3 License](http://img.shields.io/badge/license-BSD3-brightgreen.svg)++### Installation++    $ git clone https://github.com/airalab/hs-web3 && cd hs-web3+    $ stack setup+    $ stack ghci++> This library runs only paired with [geth](https://github.com/ethereum/go-ethereum)+> or [parity](https://github.com/ethcore/parity) Ethereum node,+> please start node first before using the library.++### Web3 monad++Any Ethereum node communication wrapped with `Web3` monadic type.++    > :t web3_clientVersion+    web3_clientVersion :: Web3 Text++To run this computation used `runWeb3'` or `runWeb3` functions.++    > runWeb3 web3_clientVersion+    Right "Parity//v1.4.5-beta-a028d04-20161126/x86_64-linux-gnu/rustc1.13.0"++### TemplateHaskell generator++[Quasiquotation](https://wiki.haskell.org/Quasiquotation) is used to parse+contract ABI or load from JSON file. [TemplateHaskell](https://wiki.haskell.org/Template_Haskell) driven Haskell contract API generator can automatical create instances for `Event` and `Method`+typeclasses and function helpers.++    > :set -XQuasiQuotes+    > putStr [abiFrom|data/sample.json|]+    Contract:+            Events:+                    Action1(address,uint256)+                    Action2(string,uint256)+            Methods:+                    0x03de48b3 runA1()+                    0x90126c7a runA2(string,uint256)++See example of usage.++```haskell+import Data.ByteArray (Bytes)+import Data.Text (Text)++[abiFrom|data/sample.json|]++main :: IO ()+main = do+    tx <- runWeb3 (runA2 addr nopay "Hello!" 42)+    print tx+  where addr = "0x19EE7966474b31225F71Ef8e36A71378a58a20E1"+```
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ data/sample.json view
@@ -0,0 +1,1 @@+[{"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 view
@@ -0,0 +1,13 @@+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/Unit.hs view
@@ -0,0 +1,190 @@+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances    #-}+-- |+-- Module      :  Network.Ethereum.Unit+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  unportable+--+-- Ethereum has a metric system of denominations used as units of ether.+-- Each denomination has its own unique name (some bear the family name+-- of seminal figures playing a role in evolution of computer science+-- and cryptoeconomics). The smallest denomination aka base unit of ether+-- is called 'Wei'. Below is a list of the named denominations and their+-- value in 'Wei'. Following a common (although somewhat ambiguous) pattern,+-- ether also designates a unit (of 1e18 or one quintillion 'Wei') of the+-- currency. Note that the currency is not called Ethereum as many mistakenly+-- think, nor is Ethereum a unit.+--+-- In Haskell the Ethereum unit system presented as set of types: 'Wei',+-- 'Szabo', 'Finney', etc. They are members of 'Unit' typeclass. Also available+-- standart 'Show', 'Read', 'Num' operations over Ethereum units.+--+-- @+-- > let x = 1.2 :: Ether+-- > toWei x+-- 1200000000000000000+--+-- > let y = x + 2+-- > y+-- 3.20 ether+--+-- > let z = 15 :: Szabo+-- > y + z+--+-- <interactive>:6:5: error:+--    • Couldn't match type ‘Network.Ethereum.Unit.U4’+--                    with ‘Network.Ethereum.Unit.U6’+--      Expected type: Ether+--      Actual type: Szabo+-- @+--+module Network.Ethereum.Unit (+    Unit(..)+  , Wei+  , KWei+  , MWei+  , GWei+  , Szabo+  , Finney+  , Ether+  , KEther+  ) where++import Data.Text.Lazy.Builder (toLazyText)+import Data.Text.Lazy.Builder.RealFloat+import Text.ParserCombinators.ReadPrec+import Data.Text.Lazy (Text, unpack)+import qualified Text.Read.Lex as L+import Data.Monoid ((<>))+import GHC.Read++-- | Ethereum value unit+class (UnitSpec a, Fractional a) => Unit a where+    -- | Make a value from integer wei+    fromWei :: Integer -> a+    -- | Convert a value to integer wei+    toWei :: a -> Integer+    -- | Conversion beween two values+    convert :: Unit b => a -> b+    {-# INLINE convert #-}+    convert = fromWei . toWei++-- | Unit specification+class UnitSpec a where+    divider :: RealFrac b => Value a -> b+    name    :: Value a -> Text++-- | Value abstraction+data Value a = MkValue { unValue :: Integer }+  deriving (Eq, Ord)++mkValue :: (UnitSpec a, RealFrac b) => b -> Value a+mkValue = modify res . round . (divider res *)+  where res = undefined :: UnitSpec a => Value a+        modify :: Value a -> Integer -> Value a+        modify _ = MkValue++instance UnitSpec a => Unit (Value a) where+    fromWei = MkValue+    toWei   = unValue++instance UnitSpec a => UnitSpec (Value a) where+    divider = divider . (undefined :: Value (Value a) -> Value a)+    name    = name . (undefined :: Value (Value a) -> Value a)++instance UnitSpec a => Num (Value a) where+   a + b = MkValue (unValue a + unValue b)+   a - b = MkValue (unValue a - unValue b)+   a * b = MkValue (unValue a * unValue b)++   signum (MkValue a) = MkValue (abs a)+   abs (MkValue a)    = MkValue (abs a)+   fromInteger        = mkValue . fromIntegral++instance UnitSpec a => Fractional (Value a) where+    a / b = MkValue (unValue a `div` unValue b)+    fromRational = mkValue++instance UnitSpec a => Show (Value a) where+    show val = unpack (toLazyText floatValue <> " " <> name val)+      where+        floatValue = formatRealFloat Fixed (Just 2) (x / d)+        x = fromIntegral (unValue val)+        d = divider val++instance UnitSpec a => Read (Value a) where+    readPrec = parens $ do+        x <- readPrec+        let res = mkValue x+            resName = unpack (name res)+        step $ expectP (L.Ident resName)+        return res++data U0+data U1+data U2+data U3+data U4+data U5+data U6+data U7++-- | Wei unit type+type Wei = Value U0++instance UnitSpec U0 where+    divider = const 1+    name    = const "wei"++-- | KWei unit type+type KWei = Value U1++instance UnitSpec U1 where+    divider = const 1e3+    name    = const "kwei"++-- | MWei unit type+type MWei = Value U2++instance UnitSpec U2 where+    divider = const 1e6+    name    = const "mwei"++-- | GWei unit type+type GWei = Value U3++instance UnitSpec U3 where+    divider = const 1e9+    name    = const "gwei"++-- | Szabo unit type+type Szabo = Value U4++instance UnitSpec U4 where+    divider = const 1e12+    name    = const "szabo"++-- | Finney unit type+type Finney = Value U5++instance UnitSpec U5 where+    divider = const 1e15+    name    = const "finney"++-- | Ether unit type+type Ether  = Value U6++instance UnitSpec U6 where+    divider = const 1e18+    name    = const "ether"++-- | KEther unit type+type KEther = Value U7++instance UnitSpec U7 where+    divider = const 1e21+    name    = const "kether"
+ src/Network/Ethereum/Web3.hs view
@@ -0,0 +1,45 @@+-- |+-- Module      :  Network.Ethereum.Web3+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  unknown+--+-- An Ethereum node offers a RPC interface. This interface gives Ðapp’s+-- access to the Ethereum blockchain and functionality that the node provides,+-- such as compiling smart contract code. It uses a subset of the JSON-RPC 2.0+-- specification (no support for notifications or named parameters) as serialisation+-- protocol and is available over HTTP and IPC (unix domain sockets on linux/OSX+-- and named pipe’s on Windows).+--+-- Web3 Haskell library currently use JSON-RPC over HTTP to access node functionality.+--+module Network.Ethereum.Web3 (+  -- ** Web3 monad & runners+    Web3+  , Config(..)+  , Error(..)+  , runWeb3'+  , runWeb3+  -- ** Contract actions+  , EventAction(..)+  , Event(..)+  , Method(..)+  , nopay+  -- ** ABI encoding & data types+  , ABIEncoding(..)+  , BytesN(..)+  , BytesD(..)+  , Address+  -- ** Ethereum unit conversion utils+  , module Network.Ethereum.Unit+  ) where++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/Address.hs view
@@ -0,0 +1,64 @@+-- |+-- Module      :  Network.Ethereum.Web3.Address+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  unknown+--+-- Ethereum address type, render and parser.+--+module Network.Ethereum.Web3.Address (+    Address+  , fromText+  , toText+  , zero+  ) where++import Data.Aeson (FromJSON(..), ToJSON(..), Value(..))+import Data.Text.Lazy.Builder.Int as B (hexadecimal)+import Data.Text.Lazy.Builder (toLazyText)+import Data.Text.Read as R (hexadecimal)+import Data.Text (Text, unpack, pack)+import Data.String (IsString(..))+import Data.Text.Lazy (toStrict)+import qualified Data.Text as T+import Control.Monad ((<=<))+import Data.Monoid ((<>))++-- | Ethereum account address+newtype Address = Address { unAddress :: Integer }+  deriving (Eq, Ord)++instance Show Address where+    show = unpack . toText++instance IsString Address where+    fromString a = case fromText (pack a) of+        Right address -> address+        Left e -> error e++instance FromJSON Address where+    parseJSON (String a) = either fail return (fromText a)+    parseJSON _ = fail "Address should be a string"++instance ToJSON Address where+    toJSON = toJSON . ("0x" <>) . toText++-- | Parse 'Address' from text string+fromText :: Text -> Either String Address+fromText = fmap (Address . fst) . R.hexadecimal <=< check+  where check t | T.take 2 t == "0x" = check (T.drop 2 t)+                | otherwise = if T.length t == 40 && T.all (flip elem valid) t+                              then Right t+                              else Left "This is not seems like address."+        valid = ['0'..'9'] ++ ['a'..'f'] ++ ['A'..'F']++-- | Render 'Address' to text string+toText :: Address -> Text+toText = toStrict . toLazyText . B.hexadecimal . unAddress++-- | Null address+zero :: Address+zero = Address 0
+ src/Network/Ethereum/Web3/Api.hs view
@@ -0,0 +1,59 @@+-- |+-- Module      :  Network.Ethereum.Web3.Api+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  unknown+--+-- Ethereum node JSON-RPC API methods.+--+module Network.Ethereum.Web3.Api where++import Network.Ethereum.Web3.Address+import Network.Ethereum.Web3.JsonRpc+import Network.Ethereum.Web3.Types+import Data.Text (Text)++-- | Returns current node version string.+web3_clientVersion :: Web3 Text+web3_clientVersion = remote "web3_clientVersion"++-- | Returns Keccak-256 (not the standardized SHA3-256) of the given data.+web3_sha3 :: Text -> Web3 Text+web3_sha3 = remote "web3_sha3"++-- | Returns the balance of the account of given address.+eth_getBalance :: Address -> CallMode -> Web3 Text+eth_getBalance = remote "eth_getBalance"++-- | Creates a filter object, based on filter options, to notify when the+-- state changes (logs). To check if the state has changed, call+-- 'getFilterChanges'.+eth_newFilter :: Filter -> Web3 FilterId+eth_newFilter = remote "eth_newFilter"++-- | Polling method for a filter, which returns an array of logs which+-- occurred since last poll.+eth_getFilterChanges :: FilterId -> Web3 [Change]+eth_getFilterChanges = remote "eth_getFilterChanges"++-- | Uninstalls a filter with given id.+-- Should always be called when watch is no longer needed.+eth_uninstallFilter :: FilterId -> Web3 Bool+eth_uninstallFilter = remote "eth_uninstallFilter"++-- | Executes a new message call immediately without creating a+-- transaction on the block chain.+eth_call :: Call -> CallMode -> Web3 Text+eth_call = remote "eth_call"++-- | Creates new message call transaction or a contract creation,+-- if the data field contains code.+eth_sendTransaction :: Call -> Web3 Text+eth_sendTransaction = remote "eth_sendTransaction"++-- | Returns a list of addresses owned by client.+eth_accounts :: Web3 [Address]+eth_accounts = remote "eth_accounts"
+ src/Network/Ethereum/Web3/Bytes.hs view
@@ -0,0 +1,66 @@+{-# 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 (Show, 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))++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 (Show, 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)
+ src/Network/Ethereum/Web3/Contract.hs view
@@ -0,0 +1,124 @@+-- |+-- Module      :  Network.Ethereum.Web3.Contract+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  portable+--+-- Ethereum contract generalized interface, e.g. 'event' function+-- catch all event depend by given callback function type.+--+-- @+-- runWeb3 $ event "0x..." (\(MyEvent a b c) -> print (a + b * c))+-- @+--+-- In other case 'call' function used for constant calls (without+-- transaction creation and change state), and 'sendTx' function+-- like a 'call' but return no contract method return but created+-- transaction hash.+--+-- @+-- runweb3 $ do+--   x <- call "0x.." Latest MySelector+--   tx <- sendTx "0x.." nopay $ MySelector2 (x + 2)+-- @+--+module Network.Ethereum.Web3.Contract (+    EventAction(..)+  , Method(..)+  , Event(..)+  , nopay+  ) where++import qualified Data.Text.Lazy.Builder.Int as B+import qualified Data.Text.Lazy.Builder     as B+import Control.Concurrent (ThreadId, threadDelay, forkIO)+import Control.Monad.Trans.Reader (ask)+import Control.Monad.IO.Class (liftIO)+import Data.Text.Lazy (toStrict)+import qualified Data.Text as T+import Data.Maybe (catMaybes)+import Data.Monoid ((<>))++import Network.Ethereum.Web3.Encoding+import Network.Ethereum.Web3.Address+import Network.Ethereum.Web3.Types+import Network.Ethereum.Web3.Api+import Network.Ethereum.Unit++-- | Event callback control response+data EventAction = ContinueEvent+                 -- ^ Continue to listen events+                 | TerminateEvent+                 -- ^ Terminate event listener+  deriving (Show, Eq)++-- | Contract event listener+class ABIEncoding a => Event a where+    -- | Event filter structure used by low-level subscription methods+    eventFilter :: a -> Address -> Filter++    -- | Start an event listener for given contract 'Address' and callback+    event :: Address -> (a -> IO EventAction) -> Web3 ThreadId+    event = _event++_event :: Event a => Address -> (a -> IO EventAction) -> Web3 ThreadId+_event a f = do+    fid <- let ftyp = snd $ let x = undefined :: Event a => a+                            in  (f x, x)+           in  eth_newFilter (eventFilter ftyp a)++    cfg <- ask+    liftIO $ forkIO $+        let loop = do threadDelay 1000000+                      res <- runWeb3' cfg (eth_getFilterChanges fid)+                      case res of+                          Left e -> print e+                          Right [] -> loop+                          Right changes -> do+                              acts <- mapM f $+                                  catMaybes $ fmap parseChange changes+                              if any (== TerminateEvent) acts+                              then return ()+                              else loop+        in do loop+              runWeb3' cfg (eth_uninstallFilter fid)+              return ()+  where+    prepareTopics = fmap (T.drop 2) . drop 1+    parseChange c = fromData $+        T.append (T.concat (prepareTopics $ changeTopics c))+                 (T.drop 2 $ changeData c)++-- | Contract method caller+class ABIEncoding a => Method a where+    -- | Send a transaction for given contract 'Address', value and input data+    sendTx :: Unit b => Address -> b -> a -> Web3 TxHash+    sendTx = _sendTransaction++    -- | Constant call given contract 'Address' in mode and given input data+    call :: ABIEncoding b => Address -> CallMode -> a -> Web3 b+    call = _call++_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)+  where txdata from = Call (Just from) to Nothing Nothing (Just $ toWeiText value)+        toWeiText = ("0x" <>) . toStrict . B.toLazyText . B.hexadecimal . toWei++-- 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))++-- | Zero value is used to send transaction without money+nopay :: Wei+{-# INLINE nopay #-}+nopay = 0
+ src/Network/Ethereum/Web3/Encoding.hs view
@@ -0,0 +1,67 @@+-- |+-- Module      :  Network.Ethereum.Web3.Encoding+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  portable+--+-- Web3 ABI encoding data support.+--+module Network.Ethereum.Web3.Encoding (ABIEncoding(..)) where++import Data.Text.Lazy.Builder (Builder, toLazyText, fromText, fromLazyText)+import Data.Attoparsec.Text.Lazy (parse, maybeResult, Parser)+import qualified Network.Ethereum.Web3.Address as A+import qualified Data.Attoparsec.Text          as P+import qualified Data.Text.Lazy                as LT+import qualified Data.Text                     as T+import Network.Ethereum.Web3.Address (Address)+import Network.Ethereum.Web3.EncodingUtils+import Data.Monoid ((<>))+import Data.Text (Text)++-- | Contract ABI data codec+class ABIEncoding a where+    toDataBuilder  :: a -> Builder+    fromDataParser :: Parser a++    -- | Encode value into abi-encoding represenation+    toData :: a -> Text+    toData = LT.toStrict . toLazyText . toDataBuilder++    -- | Parse encoded value+    fromData :: Text -> Maybe a+    fromData = maybeResult . parse fromDataParser . LT.fromStrict++instance ABIEncoding Bool where+    toDataBuilder  = int256HexBuilder . fromEnum+    fromDataParser = fmap toEnum int256HexParser++instance ABIEncoding Integer where+    toDataBuilder  = int256HexBuilder+    fromDataParser = int256HexParser++instance ABIEncoding Int where+    toDataBuilder  = int256HexBuilder+    fromDataParser = int256HexParser++instance ABIEncoding Word where+    toDataBuilder  = int256HexBuilder+    fromDataParser = int256HexParser++instance ABIEncoding Text where+    toDataBuilder  = textBuilder+    fromDataParser = textParser++instance ABIEncoding Address where+    toDataBuilder  = alignR . fromText . A.toText+    fromDataParser = either error id . A.fromText+                     <$> (P.take 24 *> P.take 40)++instance ABIEncoding a => ABIEncoding [a] where+    toDataBuilder x = int256HexBuilder (length x)+                      <> foldMap toDataBuilder x+    fromDataParser = do len <- int256HexParser+                        take len <$> P.many1 fromDataParser
+ src/Network/Ethereum/Web3/EncodingUtils.hs view
@@ -0,0 +1,64 @@+-- |+-- 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/Internal.hs view
@@ -0,0 +1,24 @@+-- |+-- Module      :  Network.Ethereum.Web3.Internal+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  portable+--+-- Common used internal functions.+--+module Network.Ethereum.Web3.Internal where++import Data.Char (toLower, toUpper)++-- | Lower first char of string+toLowerFirst :: String -> String+toLowerFirst [] = []+toLowerFirst (x : xs) = toLower x : xs++-- | Upper first char of string+toUpperFirst :: String -> String+toUpperFirst [] = []+toUpperFirst (x : xs) = toUpper x : xs
+ src/Network/Ethereum/Web3/JsonAbi.hs view
@@ -0,0 +1,146 @@+{-# LANGUAGE OverloadedStrings    #-}+{-# LANGUAGE TemplateHaskell      #-}+-- |+-- Module      :  Network.Ethereum.Web3.JsonAbi+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  portable+--+-- Ethereum smart contract JSON ABI types.+--+module Network.Ethereum.Web3.JsonAbi (+    ContractABI(..)+  , Declaration(..)+  , FunctionArg(..)+  , EventArg(..)+  , signature+  , methodId+  , eventId+  ) where++import Crypto.Hash (Digest, Keccak_256, hash)+import qualified Data.Text.Encoding as T+import qualified Data.Text          as T+import Network.Ethereum.Web3.Internal+import Data.Monoid ((<>))+import Data.Text (Text)+import Data.Aeson.TH+import Data.Aeson++-- | Method argument+data FunctionArg = FunctionArg+  { funArgName :: Text+  -- ^ Argument name+  , funArgType :: Text+  -- ^ Argument type+  } deriving (Show, Eq, Ord)++$(deriveJSON+    (defaultOptions {fieldLabelModifier = toLowerFirst . drop 6})+    ''FunctionArg)++-- | Event argument+data EventArg = EventArg+  { eveArgName    :: Text+  -- ^ Argument name+  , eveArgType    :: Text+  -- ^ Argument type+  , eveArgIndexed :: Bool+  -- ^ Argument is indexed (e.g. placed on topics of event)+  } deriving (Show, Eq, Ord)++$(deriveJSON+    (defaultOptions {fieldLabelModifier = toLowerFirst . drop 6})+    ''EventArg)++-- | Elementrary contract interface item+data Declaration+  = DConstructor { conInputs :: [FunctionArg] }+  -- ^ Contract constructor+  | DFunction { funName      :: Text+              , funConstant  :: Bool+              , funInputs    :: [FunctionArg]+              , funOutputs   :: Maybe [FunctionArg] }+  -- ^ Method+  | DEvent { eveName      :: Text+           , eveInputs    :: [EventArg]+           , eveAnonymous :: Bool }+  -- ^ Event+  | DFallback { falPayable :: Bool }+  -- ^ Fallback function+  deriving (Show, Eq, Ord)++$(deriveJSON (defaultOptions {+    sumEncoding = defaultTaggedObject { tagFieldName = "type" }+  , constructorTagModifier = toLowerFirst . drop 1+  , fieldLabelModifier = toLowerFirst . drop 3 })+    ''Declaration)++-- | Contract ABI is a list of method / event declarations+newtype ContractABI = ContractABI { unABI :: [Declaration] }+  deriving (Eq, Ord)++instance Show ContractABI where+    show (ContractABI c) = T.unpack $ T.unlines $+        [ "Contract:" ]+        ++ foldMap showConstructor c +++        [ "\tEvents:" ]+        ++ foldMap showEvent c +++        [ "\tMethods:" ]+        ++ foldMap showMethod c++instance FromJSON ContractABI where+    parseJSON = fmap ContractABI . parseJSON++instance ToJSON ContractABI where+    toJSON (ContractABI x) = toJSON x++showConstructor :: Declaration -> [Text]+showConstructor x = case x of+    DConstructor{} -> ["\tConstructor " <> signature x]+    _ -> []++showEvent :: Declaration -> [Text]+showEvent x = case x of+    DEvent{} -> ["\t\t" <> signature x]+    _ -> []++showMethod :: Declaration -> [Text]+showMethod x = case x of+    DFunction{} ->+        ["\t\t" <> methodId x <> " " <> signature x]+    _ -> []++-- | Take a signature by given decl, e.g. foo(uint,string)+signature :: Declaration -> Text++signature (DConstructor inputs) = "(" <> args inputs <> ")"+  where args = T.dropEnd 1 . foldMap (<> ",") . fmap funArgType++signature (DFallback _) = "()"++signature (DFunction name _ inputs _) = name <> "(" <> args inputs <> ")"+  where args = T.dropEnd 1 . foldMap (<> ",") . fmap funArgType++signature (DEvent name inputs _) = name <> "(" <> args inputs <> ")"+  where args = T.dropEnd 1 . foldMap (<> ",") . fmap eveArgType++-- | Localy compute Keccak-256 hash of given text+sha3 :: Text -> Text+{-# INLINE sha3 #-}+sha3 x = T.pack (show digest)+  where digest :: Digest Keccak_256+        digest = hash (T.encodeUtf8 x)++-- | Generate method selector by given method 'Delcaration'+methodId :: Declaration -> Text+{-# INLINE methodId #-}+methodId = ("0x" <>) . T.take 8 . sha3 . signature++-- | Generate event `topic0` hash by givent event 'Delcaration'+eventId :: Declaration -> Text+{-# INLINE eventId #-}+eventId = ("0x" <>) . sha3 . signature
+ src/Network/Ethereum/Web3/JsonRpc.hs view
@@ -0,0 +1,92 @@+{-# LANGUAGE FlexibleInstances #-}+-- |+-- Module      :  Network.JsonRpc+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  portable+--+-- Little JSON-RPC 2.0 client.+-- Functions for implementing the client side of JSON-RPC 2.0.+-- See <http://www.jsonrpc.org/specification>.+--+module Network.Ethereum.Web3.JsonRpc (remote, MethodName) where++import Network.Ethereum.Web3.Types++import Network.HTTP.Client (httpLbs, newManager, requestBody, responseBody,+                            method, requestHeaders, parseRequest,+                            RequestBody(RequestBodyLBS))+import Network.HTTP.Client.TLS (tlsManagerSettings)+import Control.Monad.Error.Class (throwError)+import Data.ByteString.Lazy (ByteString)+import Control.Monad.Trans.Reader (ask)+import Control.Monad.IO.Class (liftIO)+import Control.Applicative ((<|>))+import Control.Monad.Trans (lift)+import Data.Vector (fromList)+import Control.Monad ((>=>))+import Data.Text (Text)+import Data.Aeson++-- | Name of called method.+type MethodName = Text++-- | Remote call of JSON-RPC method.+-- Arguments of function are stored into @params@ request array.+remote :: Remote a => MethodName -> a+remote n = remote_ (call . Array . fromList)+  where connection body = do+            conf <- ask+            liftIO $ do+                manager <- newManager tlsManagerSettings+                request <- parseRequest (rpcUri conf)+                let request' = request+                             { requestBody = RequestBodyLBS body+                             , requestHeaders = [("Content-Type", "application/json")]+                             , method = "POST" }+                responseBody <$> httpLbs request' manager+        call = connection . encode . Request n 1++class Remote a where+    remote_ :: ([Value] -> Web3 ByteString) -> a++instance (ToJSON a, Remote b) => Remote (a -> b) where+    remote_ f x = remote_ (\xs -> f (toJSON x : xs))++decodeResponse :: FromJSON a => ByteString -> Web3 a+decodeResponse = tryParse . eitherDecode+             >=> tryJsonRpc . rsResult+             >=> tryParse . eitherDecode . encode+  where tryJsonRpc :: Either RpcError a -> Web3 a+        tryJsonRpc (Right a) = return a+        tryJsonRpc (Left e)  = lift $ throwError (JsonRpcFail e)+        tryParse :: Either String a -> Web3 a+        tryParse   (Right a) = return a+        tryParse   (Left e)  = lift $ throwError (ParserFail e)++instance FromJSON a => Remote (Web3 a) where+    remote_ f = decodeResponse =<< f []++-- | JSON-RPC request.+data Request = Request { rqMethod :: Text+                       , rqId     :: Int+                       , rqParams :: Value }++instance ToJSON Request where+    toJSON rq = object $ [ "jsonrpc" .= String "2.0"+                         , "method"  .= rqMethod rq+                         , "params"  .= rqParams rq+                         , "id"      .= rqId rq ]++-- | JSON-RPC response.+data Response = Response+  { rsResult :: Either RpcError Value+  } deriving (Show)++instance FromJSON Response where+    parseJSON = withObject "JSON-RPC response object" $+                \v -> Response <$>+                      (Right <$> v .: "result" <|> Left <$> v .: "error")
+ src/Network/Ethereum/Web3/TH.hs view
@@ -0,0 +1,250 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE QuasiQuotes     #-}+{-# LANGUAGE CPP             #-}+-- |+-- Module      :  Network.Ethereum.Web3.TH+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  unportable+--+-- TemplateHaskell based Ethereum contract ABI+-- methods & event generator for Haskell native API.+--+-- @+-- [abiFrom|data/sample.json|]+--+-- main = do+--     runWeb3 $ event "0x..." $+--        \(Action2 n x) -> do print n+--                             print x+--     wait+--   where wait = threadDelay 1000000 >> wait+-- @+--+module Network.Ethereum.Web3.TH (abi, abiFrom) 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.Internal+import Network.Ethereum.Web3.Contract+import Network.Ethereum.Web3.JsonAbi+import Network.Ethereum.Web3.Types+import Data.Text (Text, isPrefixOf)+import Data.Monoid (mconcat)+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+abiFrom = quoteFile abi++-- | QQ reader for contract ABI+abi :: QuasiQuoter+abi = QuasiQuoter+  { quoteDec  = quoteAbiDec+  , quoteExp  = quoteAbiExp+  , quotePat  = undefined+  , quoteType = undefined+  }++-- | Instance declaration with empty context+instanceD' :: Name -> TypeQ -> [DecQ] -> DecQ+instanceD' name insType insDecs =+    instanceD (cxt []) (appT insType (conT name)) insDecs++-- | Simple data type declaration with one constructor+dataD' :: Name -> ConQ -> [Name] -> DecQ+dataD' name rec derive =+#if MIN_VERSION_template_haskell(2,12,0)+    dataD (cxt []) name [] Nothing [rec] [derivClause Nothing (conT <$> derive)]+#else+    dataD (cxt []) name [] Nothing [rec] $ cxt (conT <$> derive)+#endif++-- | Simple function declaration+funD' :: Name -> [PatQ] -> ExpQ -> DecQ+funD' name p f = funD name [clause p (normalB f) []]++-- | ABI and Haskell types association+typeQ :: Text -> TypeQ+typeQ typ | T.any (== '[') typ = appT listT (go (T.takeWhile (/= '[') typ))+          | otherwise          = go typ+  where go x | "string"  == x         = conT (mkName "Text")+             | "address" == x         = conT (mkName "Address")+             | "bytes"   == x         = conT (mkName "BytesD")+             | "bool"    == x         = conT (mkName "Bool")+             | "bytes" `isPrefixOf` x = appT (conT (mkName "BytesN"))+                                             (numLit (T.drop 5 x))+             | "int"   `isPrefixOf` x = conT (mkName "Integer")+             | "uint"  `isPrefixOf` x = conT (mkName "Integer")+             | otherwise = fail ("Unknown type: " ++ T.unpack x)+        numLit n = litT (numTyLit (read (T.unpack n)))++-- | Event argument to TH type+eventBangType :: EventArg -> BangTypeQ+eventBangType (EventArg _ typ _) =+    bangType (bang sourceNoUnpack sourceStrict) (typeQ typ)++-- | Function argument to TH type+funBangType :: FunctionArg -> BangTypeQ+funBangType (FunctionArg _ typ) =+    bangType (bang sourceNoUnpack sourceStrict) (typeQ typ)++-- | Solidity dynamic type predicate+isDynType :: Text -> Bool+isDynType "bytes"  = True+isDynType "string" = True+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))|]]++genABIHeader :: [(Text, Name)] -> [ExpQ]+genABIHeader vars = fmap go offsetVars+  where offsetVars :: [((Text, Name), Int)]+        offsetVars = zip vars (fmap ((64 *) . (length vars +)) [0..])+        go ((typ, v), o) | isDynType typ = [|toDataBuilder (o :: Int)|]+                         | otherwise     = [|toDataBuilder $(varE v)|]++genABIData :: [(Text, Name)] -> [ExpQ]+genABIData = fmap (\(_, v) -> [|toDataBuilder $(varE v)|])++funEncodigD :: Name -> [FunctionArg] -> String -> [DecQ]+funEncodigD funName args 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 "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++eventFilterD :: String -> [DecQ]+eventFilterD topic0 = let addr = mkName "a" in+  [ funD' (mkName "eventFilter") [wildP, varP addr]+    [|Filter (Just $(varE addr))+             (Just [Just topic0, Nothing])+             Nothing+             Nothing+     |]+  ]++{-+ - TODO+ -+funTypeWrapper :: Name -> [FunctionArg] -> Maybe [FunctionArg] -> DecQ+funTypeWrapper funName args result = sigD funName funType+  where+    funType = foldl appT [t|Address|] $ arrowing (inputT ++ [outputT])+    arrowing= concat . zipWith (\a b -> [a, b]) (repeat arrowT)+    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 $+    [ dataD' eventName eventFields derivingD+    , instanceD' eventName encodingT (eventEncodigD eventName inputs)+    , instanceD' eventName eventT    (eventFilterD (T.unpack $ eventId eve))+    ]+  where eventName   = mkName (toUpperFirst (T.unpack name))+        derivingD   = [mkName "Show", mkName "Eq", mkName "Ord"]+        eventFields = normalC eventName (eventBangType <$> inputs)+        encodingT   = conT (mkName "ABIEncoding")+        eventT      = conT (mkName "Event")++-- | Method delcarations maker+mkFun :: Declaration -> Q [Dec]+mkFun fun@(DFunction name constant 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+        ]+  where mIdent    = T.unpack (methodId fun)+        funName  = mkName (toLowerFirst (T.unpack name))+        dataName = mkName (toUpperFirst (T.unpack name) ++ "Function")+        bangInput = fmap funBangType inputs+        derivingD = [mkName "Show", mkName "Eq", mkName "Ord"]+        encodingT = conT (mkName "ABIEncoding")+        methodT   = conT (mkName "Method")++-- | Declaration parser+mkDecl :: Declaration -> Q [Dec]+mkDecl x@(DFunction{}) = mkFun x+mkDecl x@(DEvent{})    = mkEvent x+mkDecl _ = return []++-- | ABI to declarations converter+quoteAbiDec :: String -> Q [Dec]+quoteAbiDec abi_string =+    case decode abi_lbs of+        Just (ContractABI abi) -> concat <$> mapM mkDecl abi+        _ -> fail "Unable to parse ABI!"+  where abi_lbs = LT.encodeUtf8 (LT.pack abi_string)++-- | ABI information string+quoteAbiExp :: String -> ExpQ+quoteAbiExp abi_string = stringE $+    case eitherDecode abi_lbs of+        Left e    -> "Error: " ++ show e+        Right abi -> show (abi :: ContractABI)+  where abi_lbs = LT.encodeUtf8 (LT.pack abi_string)
+ src/Network/Ethereum/Web3/Types.hs view
@@ -0,0 +1,133 @@+{-# LANGUAGE TemplateHaskell #-}+-- |+-- Module      :  Network.Ethereum.Web3.Types+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  portable+--+-- Common used types and instances.+--+module Network.Ethereum.Web3.Types where++import Network.Ethereum.Web3.Internal (toLowerFirst)+import Control.Monad.Trans.Reader (ReaderT, runReaderT)+import Control.Monad.Trans.Except (ExceptT, runExceptT)+import Network.Ethereum.Web3.Address (Address)+import Control.Monad.IO.Class (MonadIO(..))+import Data.Default.Class (Default(..))+import qualified Data.Text.Lazy.Builder.Int as B+import qualified Data.Text.Lazy.Builder     as B+import qualified Data.Text.Read as R+import Data.Default.Class (def)+import Data.Monoid ((<>))+import Data.Text (Text)+import Data.Aeson.TH+import Data.Aeson++-- | Any communication with Ethereum node wrapped with 'Web3' monad+type Web3 = ReaderT Config (ExceptT Error IO)++-- | Ethereum node params+data Config = Config+  { rpcUri :: String+  -- ^ JSON-RPC node URI+  } deriving (Show, Eq)++instance Default Config where+    def = Config "http://localhost:8545"++-- | Some peace of error response+data Error = JsonRpcFail RpcError+           -- ^ JSON-RPC communication error+           | ParserFail  String+           -- ^ Error in parser state+           | UserFail    String+           -- ^ Common head for user errors+  deriving (Show, Eq)++-- | Run 'Web3' monad with default config+runWeb3 :: MonadIO m => Web3 a -> m (Either Error a)+runWeb3 = runWeb3' def++-- | Run 'Web3' monad with given configuration+runWeb3' :: MonadIO m => Config -> Web3 a -> m (Either Error a)+runWeb3' c = liftIO . runExceptT . flip runReaderT c++-- | JSON-RPC error message+data RpcError = RpcError+  { errCode     :: Int+  , errMessage  :: Text+  , errData     :: Maybe Value+  } deriving (Show, Eq)++$(deriveJSON (defaultOptions+    { fieldLabelModifier = toLowerFirst . drop 3 }) ''RpcError)++-- | Low-level event filter data structure+data Filter = Filter+  { filterAddress   :: Maybe Address+  , filterTopics    :: Maybe [Maybe Text]+  , filterFromBlock :: Maybe Text+  , filterToBlock   :: Maybe Text+  } deriving Show++$(deriveJSON (defaultOptions+    { fieldLabelModifier = toLowerFirst . drop 6 }) ''Filter)++-- | Event filder ident+newtype FilterId = FilterId Int+  deriving (Show, Eq, Ord)++instance FromJSON FilterId where+    parseJSON (String v) =+        case R.hexadecimal v of+            Right (x, "") -> return (FilterId x)+            _ -> fail "Unable to parse FilterId!"+    parseJSON _ = fail "The string is required!"++instance ToJSON FilterId where+    toJSON (FilterId x) =+        let hexValue = B.toLazyText (B.hexadecimal x)+        in  toJSON ("0x" <> hexValue)++-- | Changes pulled by low-level call 'eth_getFilterChanges'+data Change = Change+  { changeLogIndex         :: Text+  , changeTransactionIndex :: Text+  , changeTransactionHash  :: Text+  , changeBlockHash        :: Text+  , changeBlockNumber      :: Text+  , changeAddress          :: Address+  , changeData             :: Text+  , changeTopics           :: [Text]+  } deriving Show++$(deriveJSON (defaultOptions+    { fieldLabelModifier = toLowerFirst . drop 6 }) ''Change)++-- | The contract call params+data Call = Call+  { callFrom    :: Maybe Address+  , callTo      :: Address+  , callGas     :: Maybe Text+  , callPrice   :: Maybe Text+  , callValue   :: Maybe Text+  , callData    :: Maybe Text+  } deriving Show++$(deriveJSON (defaultOptions+    { fieldLabelModifier = toLowerFirst . drop 4 }) ''Call)++-- | The contract call mode describe used state: latest or pending+data CallMode = Latest | Pending+  deriving (Show, Eq)++instance ToJSON CallMode where+    toJSON = toJSON . toLowerFirst . show++-- TODO: Wrap+-- | Transaction hash text string+type TxHash = Text
+ test/Spec.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes       #-}+{-# 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)++[abiFrom|data/sample.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"
+ web3.cabal view
@@ -0,0 +1,66 @@+name:                web3+version:             0.3.2.0+synopsis:            Ethereum API for Haskell+description:         Web3 is a Haskell client library for Ethereum+homepage:            https://github.com/airalab/web3#readme+license:             BSD3+license-file:        LICENSE+author:              Alexander Krupenkin+maintainer:          mail@akru.me+copyright:           Alexander Krupenkin+category:            Network+build-type:          Simple+cabal-version:       >=1.10++extra-source-files:+  README.md+  data/sample.json+  data/sample.sol++source-repository head+  type:     git+  location: https://github.com/airalab/web3++library+  hs-source-dirs:      src+  exposed-modules:     Network.Ethereum.Web3+                     , Network.Ethereum.Unit+                     , 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+  other-modules:       Network.Ethereum.Web3.JsonRpc+                     , Network.Ethereum.Web3.Internal+                     , Network.Ethereum.Web3.EncodingUtils+  build-depends:       base >= 4.5 && <4.10+                     , data-default-class+                     , base16-bytestring+                     , template-haskell+                     , http-client-tls+                     , transformers+                     , http-client+                     , attoparsec+                     , bytestring+                     , cryptonite+                     , binary+                     , vector+                     , memory+                     , aeson+                     , text+                     , mtl+  default-extensions:  OverloadedStrings+  default-language:    Haskell2010++test-suite web3-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  build-depends:       base, memory, text, web3+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  --ghc-options:         -ddump-splices -threaded -rtsopts -with-rtsopts=-N+  default-extensions:  OverloadedStrings+  default-language:    Haskell2010