airalab/hs-web3
1
1
Fork 0
mirror of https://github.com/airalab/hs-web3.git synced 2024-10-04 04:07:20 +03:00
Code Issues Projects Releases Wiki Activity

Improved docs; A lot of little fixes

Browse Source
This commit is contained in:
Alexander Krupenkin 2016-12-18 18:24:14 +03:00
parent 2336ac458f
commit 59200f9d4e
No known key found for this signature in database
GPG Key ID: 0D0A7FA67911873E
13 changed files with 257 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
README.md
View File

@ -1,4 +1,6 @@
## Ethereum Client library for Haskell
## 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)
![Hackage](https://img.shields.io/hackage/v/web3.svg)
@ -11,3 +13,48 @@
$ 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.
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"

41
src/Network/Ethereum/Unit.hs
View File

@ -9,7 +9,38 @@
-- Stability : experimental
-- Portability : unportable
--
-- Ethereum unit conversion utils.
-- 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(..)
@ -32,7 +63,7 @@ import Data.Monoid ((<>))
import GHC.Read
-- | Ethereum value unit
class Unit a where
class (UnitSpec a, Fractional a) => Unit a where
-- | Make a value from integer wei
fromWei :: Integer -> a
-- | Convert a value to integer wei
@ -57,10 +88,14 @@ mkValue = modify res . round . (divider res *)
modify :: Value a -> Integer -> Value a
modify _ = MkValue
instance Unit (Value a) where
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)

19
src/Network/Ethereum/Web3.hs
View File

@ -7,25 +7,32 @@
-- Stability : experimental
-- Portability : unknown
--
-- Web3 main module.
-- 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 (
-- ** Prime monad & runners
-- ** Web3 monad & runners
Web3
, Config(..)
, Error(..)
, runWeb3'
, runWeb3
-- ** Contract manipulation
-- ** Contract actions
, EventAction(..)
, Event(..)
, Method(..)
, nopay
-- ** ABI encoding & data types
, ABIEncoding(..)
, BytesN(..)
, BytesD(..)
, Address
-- ** Web3 monad configuration
, Config(..)
, Error(..)
-- ** Ethereum unit conversion utils
, module Network.Ethereum.Unit
) where

6
src/Network/Ethereum/Web3/Address.hs
View File

@ -7,7 +7,7 @@
-- Stability : experimental
-- Portability : unknown
--
-- Ethereum address renders and parsers.
-- Ethereum address type, render and parser.
--
module Network.Ethereum.Web3.Address (
Address
@ -27,6 +27,7 @@ import qualified Data.Text as T
import Control.Monad ((<=<))
import Data.Monoid ((<>))
-- | Ethereum account address
newtype Address = Address { unAddress :: Integer }
deriving (Eq, Ord)
@ -45,6 +46,7 @@ instance FromJSON Address where
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)
@ -53,8 +55,10 @@ fromText = fmap (Address . fst) . R.hexadecimal <=< check
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

14
src/Network/Ethereum/Web3/Api.hs
View File

@ -1,4 +1,3 @@
{-# LANGUAGE TemplateHaskell #-}
-- |
-- Module : Network.Ethereum.Web3.Api
-- Copyright : Alexander Krupenkin 2016
@ -8,7 +7,7 @@
-- Stability : experimental
-- Portability : unknown
--
-- Web3 API methods.
-- Ethereum node JSON-RPC API methods.
--
module Network.Ethereum.Web3.Api where
@ -17,12 +16,15 @@ 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"
@ -42,8 +44,16 @@ eth_getFilterChanges = remote "eth_getFilterChanges"
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"

61
src/Network/Ethereum/Web3/Contract.hs
View File

@ -1,26 +1,66 @@
-- |
-- 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
data EventAction = ContinueEvent | TerminateEvent
-- | 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
@ -52,16 +92,22 @@ _event a f = do
T.append (T.concat (prepareTopics $ changeTopics c))
(T.drop 2 $ changeData c)
-- | Contract method caller
class ABIEncoding a => Method a where
sendTx :: Address -> a -> Web3 TxHash
-- | 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 => Address -> a -> Web3 TxHash
_sendTransaction to = eth_sendTransaction . txdata
where txdata = Call Nothing to Nothing Nothing Nothing . Just . toData
_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)
@ -71,3 +117,8 @@ _call to mode dat = do res <- eth_call txdata mode
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

4
src/Network/Ethereum/Web3/Encoding.hs
View File

@ -5,7 +5,7 @@
--
-- Maintainer : mail@akru.me
-- Stability : experimental
-- Portability : POSIX / WIN32
-- Portability : portable
--
-- Web3 ABI encoding data support.
--
@ -22,7 +22,7 @@ import Network.Ethereum.Web3.EncodingUtils
import Data.Monoid ((<>))
import Data.Text (Text)
-- | ABI data encoder/decoder
-- | Contract ABI data codec
class ABIEncoding a where
toDataBuilder :: a -> Builder
fromDataParser :: Parser a

2
src/Network/Ethereum/Web3/EncodingUtils.hs
View File

@ -27,7 +27,7 @@ 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
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

20
src/Network/Ethereum/Web3/JsonAbi.hs
View File

@ -7,9 +7,9 @@
--
-- Maintainer : mail@akru.me
-- Stability : experimental
-- Portability : POSIX / WIN32
-- Portability : portable
--
-- Ethereum smart contract JSON ABI parser.
-- Ethereum smart contract JSON ABI types.
--
module Network.Ethereum.Web3.JsonAbi (
ContractABI(..)
@ -30,35 +30,47 @@ 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 {
@ -67,6 +79,7 @@ $(deriveJSON (defaultOptions {
, fieldLabelModifier = toLowerFirst . drop 3 })
''Declaration)
-- | Contract ABI is a list of method / event declarations
newtype ContractABI = ContractABI { unABI :: [Declaration] }
deriving (Eq, Ord)
@ -115,16 +128,19 @@ signature (DFunction name _ inputs _) = name <> "(" <> args inputs <> ")"
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

3
src/Network/Ethereum/Web3/JsonRpc.hs
View File

@ -6,8 +6,9 @@
--
-- Maintainer : mail@akru.me
-- Stability : experimental
-- Portability : POSIX / WIN32
-- 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>.
--

41
src/Network/Ethereum/Web3/TH.hs
View File

@ -1,5 +1,29 @@
{-# 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
@ -41,7 +65,11 @@ instanceD' name insType 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] $ fmap (derivClause Nothing . conT) derive
#else
dataD (cxt []) name [] Nothing [rec] $ cxt (conT <$> derive)
#endif
-- | Simple function declaration
funD' :: Name -> [PatQ] -> ExpQ -> DecQ
@ -160,12 +188,13 @@ funTypeWrapper funName args result = sigD funName funType
funWrapper :: Bool -> Name -> Name -> [FunctionArg] -> DecQ
funWrapper c name dname args = do
vars <- sequence $ replicate (length args + 1) (newName "t")
let params = appsE ((conE dname) : fmap varE (tail vars))
funD' name (fmap varP vars) $
case c of
True -> [|call $(varE (head vars)) Latest $(params)|]
False -> [|sendTx $(varE (head vars)) $(params)|]
(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]

20
src/Network/Ethereum/Web3/Types.hs
View File

@ -27,10 +27,10 @@ import Data.Text (Text)
import Data.Aeson.TH
import Data.Aeson
-- | Main monad type
-- | Any communication with Ethereum node wrapped with 'Web3' monad
type Web3 = ReaderT Config (ExceptT Error IO)
-- | Web3 configuration
-- | Ethereum node params
data Config = Config
{ rpcUri :: String
-- ^ JSON-RPC node URI
@ -39,20 +39,24 @@ data Config = Config
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.
-- | Run 'Web3' monad with default config
runWeb3 :: MonadIO m => Web3 a -> m (Either Error a)
runWeb3 = runWeb3' def
-- | Run 'Web3' monad.
-- | 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.
-- | JSON-RPC error message
data RpcError = RpcError
{ errCode :: Int
, errMessage :: Text
@ -62,6 +66,7 @@ data RpcError = RpcError
$(deriveJSON (defaultOptions
{ fieldLabelModifier = toLowerFirst . drop 3 }) ''RpcError)
-- | Low-level event filter data structure
data Filter = Filter
{ filterAddress :: Maybe Address
, filterTopics :: Maybe [Maybe Text]
@ -72,6 +77,7 @@ data Filter = Filter
$(deriveJSON (defaultOptions
{ fieldLabelModifier = toLowerFirst . drop 6 }) ''Filter)
-- | Event filder ident
newtype FilterId = FilterId Int
deriving (Show, Eq, Ord)
@ -87,6 +93,7 @@ instance ToJSON FilterId where
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
@ -101,6 +108,7 @@ data Change = Change
$(deriveJSON (defaultOptions
{ fieldLabelModifier = toLowerFirst . drop 6 }) ''Change)
-- | The contract call params
data Call = Call
{ callFrom :: Maybe Address
, callTo :: Address
@ -113,6 +121,7 @@ data Call = Call
$(deriveJSON (defaultOptions
{ fieldLabelModifier = toLowerFirst . drop 4 }) ''Call)
-- | The contract call mode describe used state: latest or pending
data CallMode = Latest | Pending
deriving (Show, Eq)
@ -120,4 +129,5 @@ instance ToJSON CallMode where
toJSON = toJSON . toLowerFirst . show
-- TODO: Wrap
-- | Transaction hash text string
type TxHash = Text

19
web3.cabal
View File

@ -1,8 +1,8 @@
name: web3
version: 0.3.1.0
synopsis: JSON-RPC Ethereum API for Haskell
description: Please see README.md
homepage: https://github.com/akru/web3#readme
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
@ -12,9 +12,14 @@ 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/akru/web3
location: https://github.com/airalab/web3
library
hs-source-dirs: src
@ -22,13 +27,13 @@ library
, 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.Types
, Network.Ethereum.Web3.JsonRpc
other-modules: Network.Ethereum.Web3.JsonRpc
, Network.Ethereum.Web3.Internal
, Network.Ethereum.Web3.EncodingUtils
build-depends: base >= 4.5 && <4.10