├── src └── Network │ └── Ethereum │ ├── Web3 │ ├── Types │ │ ├── Types.js │ │ ├── Provider.purs │ │ ├── Provider.js │ │ ├── EtherUnit.purs │ │ ├── TokenUnit.purs │ │ └── Types.purs │ ├── JsonRPC.js │ ├── Types.purs │ ├── Solidity.purs │ ├── JsonRPC.purs │ ├── Solidity │ │ ├── Bytes.purs │ │ ├── UInt.purs │ │ ├── Int.purs │ │ ├── Vector.purs │ │ ├── Sizes.purs │ │ ├── Internal.purs │ │ ├── Event.purs │ │ ├── Tuple.purs │ │ └── AbiEncoding.purs │ ├── Contract.purs │ ├── Api.purs │ └── Contract │ │ └── Events.purs │ └── Web3.purs ├── purescript-web3-logo.png ├── .gitignore ├── .tidyrc.json ├── .github └── workflows │ ├── tidy.yml │ └── tests.yml ├── package.json ├── test └── web3 │ ├── Web3Spec │ ├── Encoding │ │ ├── DataSpec.purs │ │ ├── SimpleSpec.purs │ │ ├── GenericSpec.purs │ │ └── ContainersSpec.purs │ ├── Types │ │ ├── VectorSpec.purs │ │ └── EtherUnitSpec.purs │ └── Live │ │ ├── Utils.purs │ │ └── RPCSpec.purs │ └── Main.purs ├── spago.yaml ├── README.md └── LICENSE /src/Network/Ethereum/Web3/Types/Types.js: -------------------------------------------------------------------------------- 1 | "use strict"; 2 | 3 | export const _null = null; -------------------------------------------------------------------------------- /purescript-web3-logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Hardcoding-1992/purescript-web3/HEAD/purescript-web3-logo.png -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | node_modules/ 2 | /output/ 3 | /generated-docs/ 4 | /.psa* 5 | package-lock.json 6 | /.vscode 7 | /.spago/ 8 | spago.lock 9 | -------------------------------------------------------------------------------- /.tidyrc.json: -------------------------------------------------------------------------------- 1 | { 2 | "indent": 2, 3 | "operatorsFile": null, 4 | "ribbon": 1, 5 | "typeArrowPlacement": "first", 6 | "unicode": "never", 7 | "width": null 8 | } 9 | -------------------------------------------------------------------------------- /.github/workflows/tidy.yml: -------------------------------------------------------------------------------- 1 | name: Code style and lint 2 | 3 | on: 4 | pull_request: 5 | branches: 6 | - master 7 | 8 | workflow_dispatch: 9 | 10 | jobs: 11 | tidy: 12 | runs-on: ubuntu-latest 13 | steps: 14 | - name: checkout 15 | uses: actions/checkout@v4 16 | with: 17 | submodules: recursive 18 | - name: run tidy 19 | run: | 20 | npm install 21 | npm run tidy-check 22 | -------------------------------------------------------------------------------- /src/Network/Ethereum/Web3/Types/Provider.purs: -------------------------------------------------------------------------------- 1 | module Network.Ethereum.Web3.Types.Provider where 2 | 3 | import Effect (Effect) 4 | 5 | -- | Represents a connection to an ethereum client 6 | foreign import data Provider :: Type 7 | 8 | -- | Produces reference to Metamask provider 9 | foreign import metamaskProvider :: Effect Provider 10 | 11 | -- | Connect to an ethereum client at a given address, eg "http://localhost:8545" 12 | foreign import httpProvider :: String -> Effect Provider 13 | -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "private": true, 3 | "scripts": { 4 | "build": "spago build", 5 | "tidy": "purs-tidy format-in-place \"src/**/*.purs\" \"test/**/*.purs\"", 6 | "tidy-check": "purs-tidy check \"src/**/*.purs\" \"test/**/*.purs\"", 7 | "test": "spago test" 8 | }, 9 | "dependencies": { 10 | "ethjs-provider-http": "^0.1.6", 11 | "keccak": "^3.0.0", 12 | "rlp": "^2.0.0", 13 | "secp256k1": "^5.0.0" 14 | }, 15 | "devDependencies": { 16 | "purescript": "^0.15.8", 17 | "purescript-psa": "^0.8.2", 18 | "purs-tidy": "^0.10.0", 19 | "spago": "next" 20 | } 21 | } 22 | -------------------------------------------------------------------------------- /src/Network/Ethereum/Web3/JsonRPC.js: -------------------------------------------------------------------------------- 1 | "use strict"; 2 | 3 | export const _sendAsync = function (provider) { 4 | return function (request) { 5 | return function(onError, onSuccess) { 6 | provider.sendAsync(request, function(err, succ) { 7 | if (err) { 8 | onError(err); 9 | } else { 10 | onSuccess(succ); 11 | } 12 | }); 13 | return function (cancelError, onCancelerError, onCancelerSuccess) { 14 | onCancelerSuccess(); 15 | }; 16 | }; 17 | }; 18 | }; 19 | -------------------------------------------------------------------------------- /.github/workflows/tests.yml: -------------------------------------------------------------------------------- 1 | name: Run test suite 2 | 3 | on: 4 | push: 5 | branches: 6 | - '*' 7 | workflow_dispatch: 8 | 9 | jobs: 10 | build: 11 | runs-on: ubuntu-latest 12 | steps: 13 | - name: checkout 14 | uses: actions/checkout@v4 15 | with: 16 | submodules: recursive 17 | - name: run tests 18 | run: | 19 | docker run -d -p 8545:8545 -e ACCOUNTS_TO_CREATE=10 foamspace/cliquebait:v1.9.12 20 | npm install 21 | while ! curl -f http://localhost:8545 >/dev/null 2>/dev/null; do "echo Waiting for Cliquebait to be ready"; sleep 10; done 22 | npm run build 23 | npm run test 24 | -------------------------------------------------------------------------------- /src/Network/Ethereum/Web3/Types/Provider.js: -------------------------------------------------------------------------------- 1 | "use strict"; 2 | import HttpProvider from "ethjs-provider-http"; 3 | 4 | export const metamaskProvider = function () { 5 | if (typeof web3 !== 'undefined') { 6 | return web3.currentProvider; 7 | } else { 8 | throw new Error("No Metamask provider found."); 9 | } 10 | }; 11 | 12 | export const httpProvider = function (providerUrl) { 13 | return function () { 14 | if (typeof web3 !== 'undefined' && web3.currentProvider.host == providerUrl) { 15 | return web3.currentProvider; 16 | } else { 17 | return new HttpProvider(providerUrl); 18 | } 19 | }; 20 | }; 21 | -------------------------------------------------------------------------------- /src/Network/Ethereum/Web3/Types/EtherUnit.purs: -------------------------------------------------------------------------------- 1 | module Network.Ethereum.Web3.Types.EtherUnit 2 | ( ETHER 3 | , Wei 4 | , Babbage 5 | , Lovelace 6 | , Shannon 7 | , Szabo 8 | , Finney 9 | , Ether 10 | , KEther 11 | ) where 12 | 13 | import Network.Ethereum.Web3.Types.TokenUnit (MinorUnit, MinorUnitE12, MinorUnitE15, MinorUnitE18, MinorUnitE21, MinorUnitE3, MinorUnitE6, MinorUnitE9, TokenK) 14 | 15 | foreign import data ETHER :: TokenK 16 | 17 | type Wei = MinorUnit ETHER 18 | 19 | type Babbage = MinorUnitE3 ETHER 20 | 21 | type Lovelace = MinorUnitE6 ETHER 22 | 23 | type Shannon = MinorUnitE9 ETHER 24 | 25 | type Szabo = MinorUnitE12 ETHER 26 | 27 | type Finney = MinorUnitE15 ETHER 28 | 29 | type Ether = MinorUnitE18 ETHER 30 | 31 | type KEther = MinorUnitE21 ETHER 32 | -------------------------------------------------------------------------------- /src/Network/Ethereum/Web3/Types.purs: -------------------------------------------------------------------------------- 1 | module Network.Ethereum.Web3.Types 2 | ( module Network.Ethereum.Web3.Types.Types 3 | , module Network.Ethereum.Web3.Types.EtherUnit 4 | , module Network.Ethereum.Web3.Types.TokenUnit 5 | , module Network.Ethereum.Types 6 | ) where 7 | 8 | import Network.Ethereum.Types (Address, BigNumber, HexString, fromInt, mkAddress, mkHexString, unAddress, unHex) 9 | import Network.Ethereum.Web3.Types.EtherUnit (Wei, Babbage, Ether, Finney, KEther, Lovelace, Shannon, Szabo, ETHER) 10 | import Network.Ethereum.Web3.Types.TokenUnit (class TokenUnit, Value, convert, formatValue, fromMinorUnit, mkValue, toMinorUnit, NoPay) 11 | import Network.Ethereum.Web3.Types.Types (forkWeb3, forkWeb3', runWeb3, Block(..), BlockNumber(..), CallError(..), ChainCursor(..), Change(..), EventAction(..), FalseOrObject(..), Filter, FilterId, MethodName, Request, Response(..), RpcError(..), SyncStatus(..), Transaction(..), TransactionOptions(..), TransactionReceipt(..), TransactionStatus(..), Web3, Web3Par, Web3Error(..), _address, _data, _from, _fromBlock, _gas, _gasPrice, _nonce, _to, _toBlock, _topics, _value, defaultFilter, defaultTransactionOptions, mkRequest, throwWeb3) 12 | -------------------------------------------------------------------------------- /src/Network/Ethereum/Web3.purs: -------------------------------------------------------------------------------- 1 | module Network.Ethereum.Web3 2 | ( module Network.Ethereum.Web3.Contract 3 | , module Network.Ethereum.Web3.Contract.Events 4 | , module Network.Ethereum.Web3.Solidity 5 | , module Network.Ethereum.Web3.Types 6 | , module Network.Ethereum.Web3.Types.Provider 7 | ) where 8 | 9 | import Network.Ethereum.Web3.Contract (class EventFilter, event, eventFilter, call, sendTx, deployContract, mkDataField) 10 | import Network.Ethereum.Web3.Contract.Events (event', EventHandler, MultiFilterStreamState(..), FilterStreamState, ChangeReceipt) 11 | import Network.Ethereum.Web3.Solidity 12 | ( Address 13 | , BigNumber 14 | , ImmutableBuffer 15 | , BytesN 16 | , UIntN 17 | , Vector 18 | , fromBuffer 19 | , abiDecode 20 | , intNFromBigNumber 21 | , nilVector 22 | , toVector 23 | , uIntNFromBigNumber 24 | , unBytesN 25 | , unIntN 26 | , unUIntN 27 | , vCons 28 | , (:<) 29 | ) 30 | import Network.Ethereum.Web3.Types (forkWeb3, forkWeb3', runWeb3, Address, Babbage, BigNumber, Block(..), BlockNumber(..), ChainCursor(..), Change(..), Ether, EventAction(..), Filter, FilterId, Finney, HexString, KEther, Lovelace, CallError(..), Shannon, Szabo, Transaction(..), TransactionOptions(..), TransactionReceipt(..), TransactionStatus(..), Value, Web3, Web3Par, Web3Error(..), Wei, _address, _data, _from, _fromBlock, _gas, _gasPrice, _nonce, _to, _toBlock, _topics, _value, convert, defaultFilter, defaultTransactionOptions, fromInt, formatValue, fromMinorUnit, mkAddress, mkHexString, mkValue, toMinorUnit, throwWeb3, unAddress, unHex) 31 | import Network.Ethereum.Web3.Types.Provider (Provider, httpProvider, metamaskProvider) 32 | -------------------------------------------------------------------------------- /test/web3/Web3Spec/Encoding/DataSpec.purs: -------------------------------------------------------------------------------- 1 | module Web3Spec.Encoding.DataSpec (spec, approve) where 2 | 3 | import Prelude 4 | 5 | import Data.Functor.Tagged (Tagged, tagged) 6 | import Data.Identity (Identity) 7 | import Effect.Class (liftEffect) 8 | import Network.Ethereum.Core.Keccak256 (toSelector) 9 | import Network.Ethereum.Core.Signatures as Address 10 | import Network.Ethereum.Web3.Contract (sendTx, mkDataField) 11 | import Network.Ethereum.Web3.Solidity (Tuple2, UIntN) 12 | import Network.Ethereum.Web3.Solidity.AbiEncoding (abiEncode) 13 | import Network.Ethereum.Web3.Solidity.Internal (fromRecord) 14 | import Network.Ethereum.Web3.Solidity.UInt as UIntN 15 | import Network.Ethereum.Web3.Types (Address, HexString, NoPay, TransactionOptions, Web3) 16 | import Test.QuickCheck (quickCheckGen, (===)) 17 | import Test.Spec (Spec, describe, it) 18 | import Type.Proxy (Proxy(..)) 19 | 20 | spec :: Spec Unit 21 | spec = 22 | describe "data maker" do 23 | it "can make the approval data" $ liftEffect do 24 | quickCheckGen do 25 | args <- { _spender: _, _value: _ } <$> Address.generator <*> UIntN.generator (Proxy @256) 26 | let 27 | approvalD = mkDataField (Proxy @ApproveFn) args 28 | 29 | sel = toSelector "approve(address,uint256)" 30 | 31 | fullDat = sel <> abiEncode args._spender <> abiEncode args._value 32 | pure $ approvalD === fullDat 33 | 34 | type ApproveFn = Tagged "approve(address,uint256)" (Tuple2 (Tagged "_spender" (Identity Address)) (Tagged "_value" (Identity (UIntN 256)))) 35 | 36 | approve :: TransactionOptions NoPay -> { _spender :: Address, _value :: (UIntN 256) } -> Web3 HexString 37 | approve txOpts r = sendTx txOpts (tagged (fromRecord r) :: ApproveFn) 38 | -------------------------------------------------------------------------------- /test/web3/Main.purs: -------------------------------------------------------------------------------- 1 | module Test.Main where 2 | 3 | import Prelude 4 | 5 | import Data.Identity (Identity(..)) 6 | import Data.Maybe (Maybe(..)) 7 | import Data.Newtype (un) 8 | import Effect (Effect) 9 | import Effect.Aff (Aff, Milliseconds(..), launchAff_) 10 | import Effect.Class (liftEffect) 11 | import Effect.Class.Console as Console 12 | import Network.Ethereum.Web3.Types.Provider (httpProvider) 13 | import Test.Spec (Spec, SpecT, mapSpecTree) 14 | import Test.Spec.Reporter.Console (consoleReporter) 15 | import Test.Spec.Runner (defaultConfig, runSpecT) 16 | import Web3Spec.Encoding.ContainersSpec as EncodingContainersSpec 17 | import Web3Spec.Encoding.DataSpec as EncodingDataSpec 18 | import Web3Spec.Encoding.GenericSpec as EncodingGenericSpec 19 | import Web3Spec.Encoding.SimpleSpec as EncodingSimpleSpec 20 | import Web3Spec.Live.RPCSpec as RPCSpec 21 | import Web3Spec.Types.EtherUnitSpec as EtherUnitSpec 22 | import Web3Spec.Types.VectorSpec as VectorSpec 23 | 24 | -- import Web3Spec.Types.EtherUnitSpec as EtherUnitSpec 25 | 26 | main :: Effect Unit 27 | main = 28 | launchAff_ 29 | do 30 | Console.log "Running tests..." 31 | let 32 | cfg = defaultConfig { timeout = Just (Milliseconds $ 120.0 * 1000.0) } 33 | p <- liftEffect $ httpProvider "http://localhost:8545" 34 | void $ join $ runSpecT cfg [ consoleReporter ] do 35 | hoist do 36 | EncodingDataSpec.spec 37 | EncodingContainersSpec.spec 38 | EncodingSimpleSpec.spec 39 | EncodingGenericSpec.spec 40 | EtherUnitSpec.spec 41 | VectorSpec.spec 42 | RPCSpec.spec p 43 | where 44 | hoist :: Spec ~> SpecT Aff Unit Aff 45 | hoist = mapSpecTree (pure <<< un Identity) identity 46 | -------------------------------------------------------------------------------- /src/Network/Ethereum/Web3/Solidity.purs: -------------------------------------------------------------------------------- 1 | module Network.Ethereum.Web3.Solidity 2 | ( module Network.Ethereum.Web3.Solidity.Vector 3 | , module Network.Ethereum.Web3.Solidity.Bytes 4 | , module Network.Ethereum.Web3.Solidity.Tuple 5 | , module Network.Ethereum.Web3.Solidity.Internal 6 | , module Network.Ethereum.Web3.Solidity.Int 7 | , module Network.Ethereum.Web3.Solidity.UInt 8 | , module Network.Ethereum.Web3.Solidity.AbiEncoding 9 | , module Network.Ethereum.Web3.Solidity.Event 10 | , module Network.Ethereum.Types 11 | , module Node.Buffer.Immutable 12 | ) where 13 | 14 | import Node.Buffer.Immutable (ImmutableBuffer) 15 | import Network.Ethereum.Types (BigNumber, Address) 16 | import Network.Ethereum.Web3.Solidity.AbiEncoding (class ABIDecode, class ABIEncode, class EncodingType, abiDecode, isDynamic, abiEncode) 17 | import Network.Ethereum.Web3.Solidity.Bytes (BytesN, unBytesN, proxyBytesN, update, fromBuffer) 18 | import Network.Ethereum.Web3.Solidity.Event (class DecodeEvent, decodeEvent, class IndexedEvent, isAnonymous) 19 | import Network.Ethereum.Web3.Solidity.Int (IntN, unIntN, intNFromBigNumber) 20 | import Network.Ethereum.Web3.Solidity.Internal (class RecordFieldsIso, fromRecord, toRecord) 21 | import Network.Ethereum.Web3.Solidity.Tuple (Tuple0(..), Tuple1(..), unTuple1, uncurry1, curry1, Tuple2(..), uncurry2, curry2, Tuple3(..), uncurry3, curry3, Tuple4(..), uncurry4, curry4, Tuple5(..), uncurry5, curry5, Tuple6(..), uncurry6, curry6, Tuple7(..), uncurry7, curry7, Tuple8(..), uncurry8, curry8, Tuple9(..), uncurry9, curry9, Tuple10(..), uncurry10, curry10, Tuple11(..), uncurry11, curry11, Tuple12(..), uncurry12, curry12, Tuple13(..), uncurry13, curry13, Tuple14(..), uncurry14, curry14, Tuple15(..), uncurry15, curry15, Tuple16(..), uncurry16, curry16) 22 | import Network.Ethereum.Web3.Solidity.UInt (UIntN, unUIntN, uIntNFromBigNumber) 23 | import Network.Ethereum.Web3.Solidity.Vector (Vector, unVector, nilVector, vCons, (:<), vectorLength, toVector) 24 | -------------------------------------------------------------------------------- /src/Network/Ethereum/Web3/JsonRPC.purs: -------------------------------------------------------------------------------- 1 | module Network.Ethereum.Web3.JsonRPC where 2 | 3 | import Prelude 4 | 5 | import Control.Monad.Except (runExcept) 6 | import Control.Monad.Reader (ask) 7 | import Data.Array ((:)) 8 | import Data.Either (Either(..)) 9 | import Effect.Aff (Aff, attempt) 10 | import Effect.Aff.Class (liftAff) 11 | import Effect.Aff.Compat (fromEffectFnAff, EffectFnAff) 12 | import Foreign (Foreign) 13 | import Network.Ethereum.Web3.Types (MethodName, Request, Response(..), Web3, Web3Error(..), mkRequest, throwWeb3) 14 | import Network.Ethereum.Web3.Types.Provider (Provider) 15 | import Simple.JSON (class ReadForeign, class WriteForeign, readImpl, writeImpl) 16 | 17 | -------------------------------------------------------------------------------- 18 | -- * Asynchronous RPC Calls 19 | -------------------------------------------------------------------------------- 20 | -- | Class representing a builder for a Web3 query 21 | class Remote a where 22 | remote_ :: (Provider -> Array Foreign -> Aff Foreign) -> a 23 | 24 | instance ReadForeign a => Remote (Web3 a) where 25 | remote_ f = do 26 | p <- ask 27 | res' <- liftAff $ attempt $ f p mempty 28 | case res' of 29 | Left uncheckedErr -> throwWeb3 $ RemoteError (show uncheckedErr) 30 | Right res -> case runExcept $ readImpl res of 31 | -- case where we get either a known Web3Error or a foreign value 32 | Left err -> throwWeb3 $ ParserError $ show err 33 | Right (Response r) -> case r of 34 | Left err -> throwWeb3 err 35 | Right a -> pure a 36 | 37 | instance (WriteForeign a, Remote b) => Remote (a -> b) where 38 | remote_ f x = remote_ $ \p args -> f p (writeImpl x : args) 39 | 40 | foreign import _sendAsync :: Provider -> Request -> EffectFnAff Foreign 41 | 42 | -- | Execute the Web3 query constructed inductively by the builder 43 | remote :: forall a. Remote a => MethodName -> a 44 | remote n = remote_ $ \provider ps -> fromEffectFnAff $ _sendAsync provider $ mkRequest n 1 ps 45 | -------------------------------------------------------------------------------- /test/web3/Web3Spec/Types/VectorSpec.purs: -------------------------------------------------------------------------------- 1 | module Web3Spec.Types.VectorSpec (spec) where 2 | 3 | import Prelude 4 | import Data.Array (uncons) 5 | import Data.Maybe (Maybe(..)) 6 | import Network.Ethereum.Web3 (Vector, nilVector, (:<)) 7 | import Partial.Unsafe (unsafeCrashWith) 8 | import Prim.Int (class Add) 9 | import Test.Spec (Spec, describe, it) 10 | import Unsafe.Coerce (unsafeCoerce) 11 | 12 | spec :: Spec Unit 13 | spec = 14 | describe "Vector-spec" do 15 | it "spec module compiles" $ pure unit 16 | 17 | unsafeVector :: forall a. Vector a Int 18 | unsafeVector = unsafeCoerce [] 19 | 20 | vec098 :: Vector 98 Int 21 | vec098 = unsafeVector 22 | 23 | vec990 :: Vector 990 Int 24 | vec990 = unsafeVector 25 | 26 | vec999 :: Vector 999 Int 27 | vec999 = unsafeVector 28 | 29 | vec99999999999999 :: Vector 99999999999999 Int 30 | vec99999999999999 = unsafeVector 31 | 32 | vec9 :: Vector 9 Int 33 | vec9 = unsafeVector 34 | 35 | vec2 :: Vector 2 Int 36 | vec2 = unsafeVector 37 | 38 | test1 :: Vector 991 Int 39 | -- test1 :: Vector _ Int 40 | test1 = 1 :< vec990 41 | 42 | test2 :: Vector 1000 Int 43 | -- test2 :: Vector _ Int 44 | test2 = 1 :< vec999 45 | 46 | test3 :: Vector 10 Int 47 | -- test3 :: Vector _ Int 48 | test3 = 1 :< vec9 49 | 50 | test4 :: Vector 3 Int 51 | -- test4 :: Vector _ Int 52 | test4 = 1 :< vec2 53 | 54 | test5 :: Vector 1004 Int 55 | -- test5 :: Vector _ Int 56 | test5 = 1 :< 1 :< 1 :< 1 :< 1 :< vec999 57 | 58 | test6 :: Vector 99 Int 59 | -- test6 :: Vector _ Int 60 | test6 = 1 :< vec098 61 | 62 | test7 :: Vector 100 Int 63 | -- test7 :: Vector _ Int 64 | test7 = 1 :< 1 :< vec098 65 | 66 | test8 :: Vector 100000000000001 Int 67 | -- test8 :: Vector _ Int 68 | test8 = 1 :< 1 :< vec99999999999999 69 | 70 | vUncons :: forall a n nDec. Add nDec 1 n => Vector n a -> { head :: a, tail :: Vector nDec a } 71 | vUncons as = case uncons $ unsafeCoerce as of 72 | Nothing -> unsafeCrashWith "impossible case in vUncons from Network.Ethereum.Web3.Solidity.Vector" 73 | Just { head, tail } -> { head, tail: unsafeCoerce tail } 74 | 75 | test12 :: Vector 3 Int 76 | test12 = (vUncons (1 :< 1 :< 1 :< 1 :< nilVector)).tail 77 | -------------------------------------------------------------------------------- /src/Network/Ethereum/Web3/Solidity/Bytes.purs: -------------------------------------------------------------------------------- 1 | module Network.Ethereum.Web3.Solidity.Bytes 2 | ( BytesN 3 | , unBytesN 4 | , proxyBytesN 5 | , update 6 | , fromBuffer 7 | , generator 8 | ) where 9 | 10 | import Prelude 11 | 12 | import Control.Monad.Gen (class MonadGen) 13 | import Node.Buffer.Immutable (ImmutableBuffer) 14 | import Node.Buffer.Immutable as B 15 | import Node.Encoding (Encoding(Hex)) 16 | import Data.Maybe (Maybe(..), fromJust) 17 | import Data.Reflectable (class Reflectable, reflectType) 18 | import Network.Ethereum.Core.HexString as Hex 19 | import Network.Ethereum.Types (mkHexString) 20 | import Partial.Unsafe (unsafePartial) 21 | import Type.Proxy (Proxy(..)) 22 | 23 | -------------------------------------------------------------------------------- 24 | -- * Statically sized byte array 25 | -------------------------------------------------------------------------------- 26 | -- Represents a statically sized bytestring of size `n` bytes. 27 | -- | See module [Network.Ethereum.Web3.Solidity.Sizes](/Network.Ethereum.Web3.Solidity.Sizes) for some predefined sizes. 28 | newtype BytesN (n :: Int) = BytesN ImmutableBuffer 29 | 30 | derive newtype instance eqBytesN :: Eq (BytesN n) 31 | instance showBytesN :: Show (BytesN n) where 32 | show (BytesN bs) = show <<< unsafePartial fromJust <<< mkHexString $ B.toString Hex bs 33 | 34 | generator :: forall n m. Reflectable n Int => MonadGen m => Proxy n -> m (BytesN n) 35 | generator p = do 36 | bs <- Hex.generator (reflectType p) 37 | pure $ BytesN $ Hex.toBuffer bs 38 | 39 | -- | Access the underlying raw bytestring 40 | unBytesN :: forall n. BytesN n -> ImmutableBuffer 41 | unBytesN (BytesN bs) = bs 42 | 43 | proxyBytesN :: forall n. BytesN n 44 | proxyBytesN = BytesN $ B.fromArray [] 45 | 46 | update :: forall n. BytesN n -> ImmutableBuffer -> BytesN n 47 | update _ = BytesN 48 | 49 | -- | Attempt to coerce a bytestring into one of the appropriate size. 50 | -- | See module [Network.Ethereum.Web3.Solidity.Sizes](/Network.Ethereum.Web3.Solidity.Sizes) for some predefined sizes. 51 | fromBuffer :: forall proxy n. Reflectable n Int => proxy n -> ImmutableBuffer -> Maybe (BytesN n) 52 | fromBuffer _ bs = 53 | if not $ B.size bs <= reflectType (Proxy :: Proxy n) then 54 | Nothing 55 | else 56 | Just $ BytesN bs 57 | -------------------------------------------------------------------------------- /spago.yaml: -------------------------------------------------------------------------------- 1 | package: 2 | name: web3 3 | dependencies: 4 | - aff: ">=7.1.0 <8.0.0" 5 | - argonaut: ">=9.0.0 <10.0.0" 6 | - arrays: ">=7.3.0 <8.0.0" 7 | - bifunctors: ">=6.0.0 <7.0.0" 8 | - control: ">=6.0.0 <7.0.0" 9 | - coroutine-transducers: "*" 10 | - coroutines: ">=7.0.0 <8.0.0" 11 | - effect: ">=4.0.0 <5.0.0" 12 | - either: ">=6.1.0 <7.0.0" 13 | - eth-core: "*" 14 | - exceptions: ">=6.1.0 <7.0.0" 15 | - foldable-traversable: ">=6.0.0 <7.0.0" 16 | - foreign: ">=7.0.0 <8.0.0" 17 | - foreign-object: ">=4.1.0 <5.0.0" 18 | - fork: ">=6.0.0 <7.0.0" 19 | - gen: ">=4.0.0 <5.0.0" 20 | - heterogeneous: ">=0.6.0 <0.7.0" 21 | - identity: ">=6.0.0 <7.0.0" 22 | - maybe: ">=6.0.0 <7.0.0" 23 | - newtype: ">=5.0.0 <6.0.0" 24 | - node-buffer: ">=9.0.0 <10.0.0" 25 | - parallel: ">=6.0.0 <7.0.0" 26 | - parsing: ">=10.2.0 <11.0.0" 27 | - partial: ">=4.0.0 <5.0.0" 28 | - prelude: ">=6.0.1 <7.0.0" 29 | - profunctor-lenses: ">=8.0.0 <9.0.0" 30 | - record: ">=4.0.0 <5.0.0" 31 | - ring-modules: ">=5.0.1 <6.0.0" 32 | - simple-json: ">=9.0.0 <10.0.0" 33 | - strings: ">=6.0.1 <7.0.0" 34 | - tagged: ">=4.0.2 <5.0.0" 35 | - tailrec: ">=6.1.0 <7.0.0" 36 | - transformers: ">=6.1.0 <7.0.0" 37 | - tuples: ">=7.0.0 <8.0.0" 38 | - typelevel-prelude: ">=7.0.0 <8.0.0" 39 | - unfoldable: ">=6.0.0 <7.0.0" 40 | - unsafe-coerce: ">=6.0.0 <7.0.0" 41 | - variant: ">=8.0.0 <9.0.0" 42 | test: 43 | main: Test.Main 44 | dependencies: 45 | - quickcheck 46 | - quickcheck-laws 47 | - spec 48 | - spec-node 49 | workspace: 50 | extraPackages: 51 | coroutine-transducers: 52 | dependencies: 53 | - aff 54 | - console 55 | - coroutines 56 | - effect 57 | - either 58 | - foldable-traversable 59 | - freet 60 | - functors 61 | - maybe 62 | - newtype 63 | - parallel 64 | - prelude 65 | - psci-support 66 | - tailrec 67 | - transformers 68 | - tuples 69 | git: https://github.com/martyall/purescript-coroutine-transducers 70 | ref: v1.0.0 71 | eth-core: 72 | git: https://github.com/f-o-a-m/purescript-eth-core 73 | ref: 3db27d22f738498a1e4263f537cd25279fc88088 74 | -------------------------------------------------------------------------------- /src/Network/Ethereum/Web3/Solidity/UInt.purs: -------------------------------------------------------------------------------- 1 | module Network.Ethereum.Web3.Solidity.UInt 2 | ( UIntN 3 | , unUIntN 4 | , uIntNFromBigNumber 5 | , generator 6 | ) where 7 | 8 | import Prelude 9 | 10 | import Control.Monad.Gen (class MonadGen, chooseInt) 11 | import Data.Maybe (Maybe(..)) 12 | import Data.Reflectable (class Reflectable, reflectType) 13 | import Network.Ethereum.Core.BigNumber (BigNumber, fromInt, fromString, pow) 14 | import Network.Ethereum.Core.HexString as Hex 15 | import Partial.Unsafe (unsafeCrashWith) 16 | import Type.Proxy (Proxy(..)) 17 | 18 | -------------------------------------------------------------------------------- 19 | -- * Statically sized unsigned integers 20 | -------------------------------------------------------------------------------- 21 | -- | Represents a statically sized unsigned integer of size `n`. 22 | -- | See module [Network.Ethereum.Web3.Solidity.Sizes](/Network.Ethereum.Web3.Solidity.Sizes) for some predefined sizes. 23 | newtype UIntN (n :: Int) = UIntN BigNumber 24 | 25 | derive newtype instance showUIntN :: Show (UIntN n) 26 | derive newtype instance eqUIntN :: Eq (UIntN n) 27 | derive newtype instance ordUIntN :: Ord (UIntN n) 28 | 29 | generator 30 | :: forall n m 31 | . Reflectable n Int 32 | => MonadGen m 33 | => Proxy n 34 | -> m (UIntN n) 35 | generator p = do 36 | let nBits = reflectType p 37 | nBytes <- flip div 8 <$> chooseInt 1 nBits 38 | bs <- Hex.generator nBytes 39 | let 40 | a = 41 | if bs == mempty then zero 42 | else case fromString $ Hex.unHex bs of 43 | Nothing -> unsafeCrashWith $ "uint" <> show nBits <> " generator: invalid hex string: " <> show bs 44 | Just x -> x 45 | pure $ UIntN $ if a < zero then -a else a 46 | 47 | -- | Access the raw underlying unsigned integer 48 | unUIntN :: forall n. UIntN n -> BigNumber 49 | unUIntN (UIntN a) = a 50 | 51 | -- | Attempt to coerce an unsigned integer into a statically sized one. 52 | -- | See module [Network.Ethereum.Web3.Solidity.Sizes](/Network.Ethereum.Web3.Solidity.Sizes) for some predefined sizes. 53 | uIntNFromBigNumber :: forall n. Reflectable n Int => Proxy n -> BigNumber -> Maybe (UIntN n) 54 | uIntNFromBigNumber _ a 55 | | a < zero = Nothing 56 | | otherwise = 57 | let 58 | maxVal = (fromInt 2) `pow` (reflectType (Proxy :: Proxy n)) - one 59 | in 60 | if a > maxVal then Nothing else Just <<< UIntN $ a 61 | -------------------------------------------------------------------------------- /src/Network/Ethereum/Web3/Solidity/Int.purs: -------------------------------------------------------------------------------- 1 | module Network.Ethereum.Web3.Solidity.Int 2 | ( IntN 3 | , unIntN 4 | , intNFromBigNumber 5 | , generator 6 | ) where 7 | 8 | import Prelude 9 | 10 | import Control.Monad.Gen (class MonadGen) 11 | import Data.Maybe (Maybe(..)) 12 | import Data.Reflectable (class Reflectable, reflectType) 13 | import Network.Ethereum.Core.BigNumber (BigNumber, fromInt, fromString, fromTwosComplement, pow) 14 | import Network.Ethereum.Core.HexString as Hex 15 | import Partial.Unsafe (unsafeCrashWith) 16 | import Type.Proxy (Proxy(..)) 17 | 18 | -------------------------------------------------------------------------------- 19 | -- * Statically sized signed integers 20 | -------------------------------------------------------------------------------- 21 | -- | Represents a statically sized signed integer of size `n` bytes. 22 | -- | See module [Network.Ethereum.Web3.Solidity.Sizes](/Network.Ethereum.Web3.Solidity.Sizes) for some predefined sizes. 23 | newtype IntN (n :: Int) = IntN BigNumber 24 | 25 | derive newtype instance showIntN :: Show (IntN n) 26 | derive newtype instance eqIntN :: Eq (IntN n) 27 | derive newtype instance ordIntN :: Ord (IntN n) 28 | 29 | generator :: forall n m. Reflectable n Int => MonadGen m => Proxy n -> m (IntN n) 30 | generator p = do 31 | bs <- Hex.generator (reflectType p `div` 8) 32 | let 33 | n = reflectType (Proxy @n) 34 | a = 35 | if bs == mempty then zero 36 | else case fromString $ Hex.unHex $ bs of 37 | Nothing -> unsafeCrashWith $ "int" <> show n <> " generator: invalid hex string: " <> show bs 38 | Just x -> x 39 | pure $ IntN $ fromTwosComplement n a 40 | 41 | -- | Access the raw underlying integer 42 | unIntN :: forall n. IntN n -> BigNumber 43 | unIntN (IntN a) = a 44 | 45 | -- | Attempt to coerce an signed `BigNumber` into a statically sized one. 46 | -- | See module [Network.Ethereum.Web3.Solidity.Sizes](/Network.Ethereum.Web3.Solidity.Sizes) for some predefined sizes. 47 | intNFromBigNumber :: forall n proxy. Reflectable n Int => proxy n -> BigNumber -> Maybe (IntN n) 48 | intNFromBigNumber _ a 49 | | a < zero = 50 | let 51 | minVal = negate $ (fromInt 2) `pow` (reflectType (Proxy @n) - one) 52 | in 53 | if a < minVal then Nothing else Just <<< IntN $ a 54 | | otherwise = 55 | let 56 | maxVal = (fromInt 2) `pow` (reflectType (Proxy @n) - one) - one 57 | in 58 | if a > maxVal then Nothing else Just <<< IntN $ a 59 | -------------------------------------------------------------------------------- /src/Network/Ethereum/Web3/Solidity/Vector.purs: -------------------------------------------------------------------------------- 1 | module Network.Ethereum.Web3.Solidity.Vector 2 | ( Vector 3 | , unVector 4 | , nilVector 5 | , vCons 6 | , (:<) 7 | , vectorLength 8 | , toVector 9 | , generator 10 | ) where 11 | 12 | import Prelude 13 | 14 | import Control.Monad.Gen (class MonadGen) 15 | import Data.Array ((:)) 16 | import Data.Array as A 17 | import Data.Foldable (class Foldable) 18 | import Data.Maybe (Maybe(..)) 19 | import Data.Reflectable (class Reflectable, reflectType) 20 | import Data.Traversable (class Traversable) 21 | import Data.Unfoldable (class Unfoldable, class Unfoldable1, replicateA) 22 | import Prim.Int (class Add) 23 | import Type.Proxy (Proxy(..)) 24 | 25 | -- | Represents a statically sized vector of length `n`. 26 | -- | See module [Network.Ethereum.Web3.Solidity.Sizes](/Network.Ethereum.Web3.Solidity.Sizes) for some predefined sizes. 27 | newtype Vector (n :: Int) a = Vector (Array a) 28 | 29 | derive newtype instance Show a => Show (Vector n a) 30 | derive newtype instance Eq a => Eq (Vector n a) 31 | derive newtype instance Functor (Vector n) 32 | derive newtype instance Unfoldable1 (Vector n) 33 | derive newtype instance Unfoldable (Vector n) 34 | derive newtype instance Foldable (Vector n) 35 | derive newtype instance Traversable (Vector n) 36 | 37 | generator 38 | :: forall n m proxy a 39 | . Reflectable n Int 40 | => MonadGen m 41 | => proxy n 42 | -> m a 43 | -> m (Vector n a) 44 | generator _ gen = Vector <$> replicateA (reflectType (Proxy @n)) gen 45 | 46 | -- | Access the underlying array 47 | unVector :: forall a n. Vector n a -> Array a 48 | unVector (Vector as) = as 49 | 50 | -- | Array of length 0 51 | nilVector :: forall a. Vector 0 a 52 | nilVector = Vector mempty 53 | 54 | -- | Dependently typed `cons` 55 | vCons :: forall a n nInc. Add n 1 nInc => a -> Vector n a -> Vector nInc a 56 | vCons a (Vector as) = Vector (a : as) 57 | 58 | infixr 6 vCons as :< 59 | 60 | -- | Get the length of a statically sized vector 61 | vectorLength :: forall a n. Vector n a -> Int 62 | vectorLength (Vector as) = A.length as 63 | 64 | -- | Attempt to coerce an array into a statically sized array. 65 | -- | See module [Network.Ethereum.Web3.Solidity.Sizes](/Network.Ethereum.Web3.Solidity.Sizes) for some predefined sizes. 66 | toVector :: forall a (n :: Int) proxy. Reflectable n Int => proxy n -> Array a -> Maybe (Vector n a) 67 | toVector _ as = 68 | if reflectType (Proxy @n) /= A.length as then 69 | Nothing 70 | else 71 | Just (Vector as) 72 | -------------------------------------------------------------------------------- /test/web3/Web3Spec/Live/Utils.purs: -------------------------------------------------------------------------------- 1 | module Web3Spec.Live.Utils 2 | ( assertWeb3 3 | , bigGasLimit 4 | , defaultTestTxOptions 5 | , go 6 | , pollTransactionReceipt 7 | ) where 8 | 9 | import Prelude 10 | 11 | import Control.Monad.Reader (ReaderT, runReaderT) 12 | import Data.Array.NonEmpty as NAE 13 | import Data.Either (Either(..)) 14 | import Data.Lens ((?~)) 15 | import Data.Maybe (fromJust) 16 | import Data.Traversable (intercalate) 17 | import Effect.Aff (Aff, Milliseconds(..), delay) 18 | import Effect.Aff.Class (class MonadAff, liftAff) 19 | import Effect.Class.Console as C 20 | import Network.Ethereum.Core.BigNumber (decimal, fromStringAs) 21 | import Network.Ethereum.Web3 (BigNumber, HexString, Provider, TransactionOptions, TransactionReceipt(..), TransactionStatus(..), Web3, _gas, defaultTransactionOptions, runWeb3) 22 | import Network.Ethereum.Web3.Api as Api 23 | import Network.Ethereum.Web3.Types (NoPay) 24 | import Partial.Unsafe (unsafeCrashWith, unsafePartial) 25 | import Test.Spec (ComputationType(..), SpecT, hoistSpec) 26 | 27 | type Logger m = String -> m Unit 28 | 29 | go :: SpecT (ReaderT (Logger Aff) Aff) Unit Aff ~> SpecT Aff Unit Aff 30 | go = 31 | hoistSpec identity \cType m -> 32 | let 33 | prefix = case cType of 34 | CleanUpWithContext n -> intercalate " > " n <> " (afterAll) " 35 | TestWithName n -> intercalate " > " $ NAE.toArray n 36 | in 37 | runReaderT m \logMsg -> C.log $ prefix <> "| " <> logMsg 38 | 39 | -- | Assert the `Web3` action's result, crash the program if it doesn't succeed. 40 | assertWeb3 41 | :: forall m a 42 | . MonadAff m 43 | => Provider 44 | -> Web3 a 45 | -> m a 46 | assertWeb3 provider a = 47 | liftAff $ runWeb3 provider a 48 | <#> case _ of 49 | Right x -> x 50 | Left err -> unsafeCrashWith $ "expected Right in `assertWeb3`, got error" <> show err 51 | 52 | pollTransactionReceipt 53 | :: forall m a 54 | . MonadAff m 55 | => Provider 56 | -> HexString 57 | -> (TransactionReceipt -> Aff a) 58 | -> m a 59 | pollTransactionReceipt provider txHash k = 60 | liftAff do 61 | eRes <- runWeb3 provider $ Api.eth_getTransactionReceipt txHash 62 | case eRes of 63 | Left _ -> do 64 | delay (Milliseconds 2000.0) 65 | pollTransactionReceipt provider txHash k 66 | Right receipt@(TransactionReceipt res) -> case res.status of 67 | Succeeded -> k receipt 68 | Failed -> unsafeCrashWith $ "Transaction failed : " <> show txHash 69 | 70 | defaultTestTxOptions :: TransactionOptions NoPay 71 | defaultTestTxOptions = defaultTransactionOptions # _gas ?~ bigGasLimit 72 | 73 | bigGasLimit :: BigNumber 74 | bigGasLimit = unsafePartial fromJust $ fromStringAs decimal "4712388" 75 | -------------------------------------------------------------------------------- /src/Network/Ethereum/Web3/Solidity/Sizes.purs: -------------------------------------------------------------------------------- 1 | module Network.Ethereum.Web3.Solidity.Sizes where 2 | 3 | import Type.Proxy (Proxy(..)) 4 | 5 | s1 :: Proxy 1 6 | s1 = Proxy 7 | 8 | s2 :: Proxy 2 9 | s2 = Proxy 10 | 11 | s3 :: Proxy 3 12 | s3 = Proxy 13 | 14 | s4 :: Proxy 4 15 | s4 = Proxy 16 | 17 | s5 :: Proxy 5 18 | s5 = Proxy 19 | 20 | s6 :: Proxy 6 21 | s6 = Proxy 22 | 23 | s7 :: Proxy 7 24 | s7 = Proxy 25 | 26 | s8 :: Proxy 8 27 | s8 = Proxy 28 | 29 | s9 :: Proxy 9 30 | s9 = Proxy 31 | 32 | s10 :: Proxy 10 33 | s10 = Proxy 34 | 35 | s11 :: Proxy 11 36 | s11 = Proxy 37 | 38 | s12 :: Proxy 12 39 | s12 = Proxy 40 | 41 | s13 :: Proxy 13 42 | s13 = Proxy 43 | 44 | s14 :: Proxy 14 45 | s14 = Proxy 46 | 47 | s15 :: Proxy 15 48 | s15 = Proxy 49 | 50 | s16 :: Proxy 16 51 | s16 = Proxy 52 | 53 | s17 :: Proxy 17 54 | s17 = Proxy 55 | 56 | s18 :: Proxy 18 57 | s18 = Proxy 58 | 59 | s19 :: Proxy 19 60 | s19 = Proxy 61 | 62 | s20 :: Proxy 20 63 | s20 = Proxy 64 | 65 | s21 :: Proxy 21 66 | s21 = Proxy 67 | 68 | s22 :: Proxy 22 69 | s22 = Proxy 70 | 71 | s23 :: Proxy 23 72 | s23 = Proxy 73 | 74 | s24 :: Proxy 24 75 | s24 = Proxy 76 | 77 | s25 :: Proxy 25 78 | s25 = Proxy 79 | 80 | s26 :: Proxy 26 81 | s26 = Proxy 82 | 83 | s27 :: Proxy 27 84 | s27 = Proxy 85 | 86 | s28 :: Proxy 28 87 | s28 = Proxy 88 | 89 | s29 :: Proxy 29 90 | s29 = Proxy 91 | 92 | s30 :: Proxy 30 93 | s30 = Proxy 94 | 95 | s31 :: Proxy 31 96 | s31 = Proxy 97 | 98 | s32 :: Proxy 32 99 | s32 = Proxy 100 | 101 | s40 :: Proxy 40 102 | s40 = Proxy 103 | 104 | s48 :: Proxy 48 105 | s48 = Proxy 106 | 107 | s56 :: Proxy 56 108 | s56 = Proxy 109 | 110 | s64 :: Proxy 64 111 | s64 = Proxy 112 | 113 | s72 :: Proxy 72 114 | s72 = Proxy 115 | 116 | s80 :: Proxy 80 117 | s80 = Proxy 118 | 119 | s88 :: Proxy 88 120 | s88 = Proxy 121 | 122 | s96 :: Proxy 96 123 | s96 = Proxy 124 | 125 | s104 :: Proxy 104 126 | s104 = Proxy 127 | 128 | s112 :: Proxy 112 129 | s112 = Proxy 130 | 131 | s120 :: Proxy 120 132 | s120 = Proxy 133 | 134 | s128 :: Proxy 128 135 | s128 = Proxy 136 | 137 | s136 :: Proxy 136 138 | s136 = Proxy 139 | 140 | s144 :: Proxy 144 141 | s144 = Proxy 142 | 143 | s152 :: Proxy 152 144 | s152 = Proxy 145 | 146 | s160 :: Proxy 160 147 | s160 = Proxy 148 | 149 | s168 :: Proxy 168 150 | s168 = Proxy 151 | 152 | s176 :: Proxy 176 153 | s176 = Proxy 154 | 155 | s184 :: Proxy 184 156 | s184 = Proxy 157 | 158 | s192 :: Proxy 192 159 | s192 = Proxy 160 | 161 | s200 :: Proxy 200 162 | s200 = Proxy 163 | 164 | s208 :: Proxy 208 165 | s208 = Proxy 166 | 167 | s216 :: Proxy 216 168 | s216 = Proxy 169 | 170 | s224 :: Proxy 224 171 | s224 = Proxy 172 | 173 | s232 :: Proxy 232 174 | s232 = Proxy 175 | 176 | s240 :: Proxy 240 177 | s240 = Proxy 178 | 179 | s248 :: Proxy 248 180 | s248 = Proxy 181 | 182 | s256 :: Proxy 256 183 | s256 = Proxy 184 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # purescript-web3 2 | 3 | 4 | 5 | # A Purescript Client for the Web3 API 6 | 7 | `purescript-web3` is a library for interacting with an ethereum node in purescript. 8 | 9 | Using [purescript-web3-generator](https://github.com/f-o-a-m/purescript-web3-generator) or [chanterelle](https://github.com/f-o-a-m/chanterelle) it is also possible (and recommended) to generate a library from a set of smart contract abis which is capable of templating transactions and event filters/watchers. The README has instructions for getting started. 10 | 11 | To see an example project, it is recommended to look at the [tests repository](https://github.com/f-o-a-m/purescript-web3-tests) (which uses Chanterelle) 12 | 13 | ## Build Instructions 14 | ``` 15 | > npm install 16 | > npm run build 17 | > docker run -d -p 8545:8545 -e ACCOUNTS_TO_CREATE=10 foamspace/cliquebait:v1.9.12 18 | > npm run test 19 | ``` 20 | 21 | ## Documentation 22 | 23 | Module documentation is [published on Pursuit](http://pursuit.purescript.org/packages/purescript-web3). 24 | 25 | ## Examples 26 | 27 | Suppose we have the following solidity smart contract: 28 | 29 | ```solidity 30 | contract TupleStorage { 31 | 32 | uint x; 33 | uint y; 34 | 35 | event TupleSet(uint newX, uint newY); 36 | 37 | function setTuple(uint _x, uint _y) public { 38 | x = _x; 39 | y = _y; 40 | TupleSet(_x, _y); 41 | } 42 | 43 | } 44 | ``` 45 | 46 | If we used [purescript-web3-generator](https://github.com/f-o-a-m/purescript-web3-generator), we are given a function with the following signature: 47 | 48 | ```purescript 49 | setTuple :: forall e. 50 | TransactionOptions NoPay 51 | -> {_x :: UIntN 256, _y :: UIntN 256} 52 | -> Web3 HexString 53 | ``` 54 | 55 | It's pretty clear what this function is doing, but let's look at the `TransactionOptions`. This record keeps track of, for example, who is the transaction from, what contract address is it going to, is there ether being sent, etc. In this case, the function is not "payable", so this is indicated in the type of the `TransactionOptions`. It is set using lenses like: 56 | 57 | ```purescript 58 | setTupleOpts :: TransactionOptions NoPay 59 | setTupleOpts = defaultTransactionOptions 60 | # _from ?~ myAddress 61 | # _to ?~ tupleStorageAddress 62 | ``` 63 | Now for the `TupleSet` event. In order to start an event watcher, we need to establish the `Filter`, which specifies things like the range of blocks we are interested in, and how to find that particular contract and topic. Again, if you're using web3-generator, things are a lot simpler: 64 | 65 | ```purescript 66 | tupleFilter :: Filter TupleSet 67 | tupleFilter = eventFilter (Proxy :: Proxy TupleSet) tupleStorageAddress 68 | # _fromBlock .~ BN 100 69 | ``` 70 | 71 | We also need to pass a callback to the event watcher that performs some action and decides whether or not to unregister the filter. For example, we could set up an event monitor starting from block 100 and continuing until the two coordinates that are set are equal: 72 | 73 | ```purescript 74 | event tupleFilter $ \(TupleSet {newX,newY} -> do 75 | log $ "Received New Tuple : " <> show (Tuple newX newY) 76 | if newX == newY 77 | then pure TerminateEvent 78 | else do 79 | _ <- performAction newX newY 80 | pure ContinueEvent 81 | ``` 82 | 83 | ## Resources 84 | 85 | - [web3 api spec](https://github.com/ethereum/execution-apis) 86 | - [solidity ABI spec](https://docs.soliditylang.org/en/latest/abi-spec.html) 87 | -------------------------------------------------------------------------------- /test/web3/Web3Spec/Types/EtherUnitSpec.purs: -------------------------------------------------------------------------------- 1 | module Web3Spec.Types.EtherUnitSpec (spec) where 2 | 3 | import Prelude 4 | 5 | import Control.Apply (lift2, lift3) 6 | import Data.Lens ((.~), (^.)) 7 | import Data.Maybe (Maybe(..)) 8 | import Data.Ring.Module (class LeftModule, mzeroL, (^*), (^+), (^-)) 9 | import Data.Tuple (Tuple(..)) 10 | import Effect (Effect) 11 | import Effect.Class (liftEffect) 12 | import Effect.Class.Console (log) 13 | import Network.Ethereum.Core.BigNumber (pow) 14 | import Network.Ethereum.Web3 (Shannon, Szabo, Value, Wei, Ether, _value, convert, defaultTransactionOptions, formatValue, fromInt, fromMinorUnit, mkValue) 15 | import Network.Ethereum.Web3.Types.TokenUnit as Value 16 | import Test.QuickCheck (arbitrary, quickCheck', (===)) 17 | import Test.QuickCheck.Gen (Gen, chooseInt) 18 | import Test.QuickCheck.Laws (checkLaws) 19 | import Test.QuickCheck.Laws.Data as Data 20 | import Test.Spec (Spec, describe, it) 21 | import Test.Spec.Assertions (shouldEqual) 22 | import Type.Proxy (Proxy(..)) 23 | 24 | spec :: Spec Unit 25 | spec = describe "ether unit spec" do 26 | describe "conversion tests" do 27 | it "can encode convert from a higher denomination to lower" do 28 | let 29 | inEth = convert (mkValue one :: Value Ether) 30 | 31 | inWei = (mkValue $ (fromInt 10) `pow` 18) :: Value Wei 32 | inEth `shouldEqual` inWei 33 | let 34 | shannon = mkValue (fromInt 10 `pow` 3) :: Value Shannon 35 | 36 | szabo = mkValue one :: Value Szabo 37 | convert shannon `shouldEqual` szabo 38 | 39 | it "can perform arithmetic" do 40 | let 41 | two = mkValue (fromInt 1 + fromInt 1) :: Value Shannon 42 | 43 | two' = mkValue one ^+ mkValue one 44 | two `shouldEqual` two' 45 | (two ^- two') `shouldEqual` mzeroL 46 | (2 ^* two') `shouldEqual` mkValue (fromInt 4) 47 | 48 | it "can use the lens properly" do 49 | let 50 | noPay = defaultTransactionOptions 51 | 52 | opts = defaultTransactionOptions # _value .~ Just (convert (mkValue one :: Value Ether)) 53 | (noPay ^. _value) `shouldEqual` Nothing 54 | (opts ^. _value) `shouldEqual` (Just (fromMinorUnit (fromInt 10 `pow` 18) :: Value Wei)) 55 | 56 | it "can format currencies correctly" do 57 | let 58 | n = mkValue (fromInt 1) :: Value Ether 59 | 60 | m = convert n :: Value Wei 61 | 62 | -- making the loop shouldn't change the result 63 | n' = convert m :: Value Ether 64 | formatValue n `shouldEqual` "1" 65 | formatValue n' `shouldEqual` "1" 66 | formatValue m `shouldEqual` "1000000000000000000" 67 | 68 | describe "laws" do 69 | it "satisfies basic laws" $ liftEffect $ checkLaws "Value Ether" $ do 70 | Data.checkEqGen $ Value.generator (Proxy @Ether) 71 | Data.checkOrdGen $ Value.generator (Proxy @Ether) 72 | Data.checkSemigroupGen $ Value.generator (Proxy @Ether) 73 | Data.checkMonoidGen $ Value.generator (Proxy @Ether) 74 | checkLeftModuleGen arbitrary smallIntsGen (Value.generator (Proxy @Ether)) 75 | 76 | checkLeftModuleGen 77 | :: forall r m 78 | . LeftModule m r 79 | => Eq m 80 | => Show m 81 | => Gen r 82 | -- need this because of overflow (see smallIntsGen) 83 | -> Gen (Tuple r r) 84 | -> Gen m 85 | -> Effect Unit 86 | checkLeftModuleGen genR genRR genM = do 87 | log "Checking 'Distributivity1' law for LeftModule" 88 | quickCheck' 1000 $ lift3 distributivity1 genR genM genM 89 | log "Checking 'Distributivity2' law for LeftModule" 90 | quickCheck' 1000 $ lift3 distributivity2 genR genR genM 91 | log "Checking 'Compatibility' law for LeftModule" 92 | quickCheck' 1000 $ lift2 compatibility genRR genM 93 | log "Checking 'identity' law for LeftModule" 94 | quickCheck' 1000 $ (_identity <$> genM) 95 | 96 | where 97 | distributivity1 r x y = r ^* (x ^+ y) === r ^* x ^+ r ^* y 98 | distributivity2 r s x = (r + s) ^* x === r ^* x ^+ s ^* x 99 | compatibility (Tuple r s) x = (r * s) ^* x === r ^* (s ^* x) 100 | _identity x = one ^* x === x 101 | 102 | smallIntsGen :: Gen (Tuple Int Int) 103 | smallIntsGen = do 104 | n1 <- arbitrary 105 | n2 <- chooseInt 0 (top `div` n1) 106 | pure $ Tuple n1 n2 -------------------------------------------------------------------------------- /test/web3/Web3Spec/Encoding/SimpleSpec.purs: -------------------------------------------------------------------------------- 1 | module Web3Spec.Encoding.SimpleSpec (spec) where 2 | 3 | import Prelude 4 | import Effect.Aff (error, throwError) 5 | import Control.Monad.Except (runExcept) 6 | import Data.Either (Either(Right), either) 7 | import Foreign (ForeignError) 8 | import Data.List.Types (NonEmptyList) 9 | import Data.Maybe (Maybe(..), fromJust) 10 | import Data.Newtype (unwrap) 11 | import Network.Ethereum.Web3.Types (BigNumber, Block, FalseOrObject(..), HexString, SyncStatus(..), fromInt, mkHexString) 12 | import Partial.Unsafe (unsafePartial) 13 | import Simple.JSON (readJSON') 14 | import Test.Spec (Spec, describe, it) 15 | import Test.Spec.Assertions (shouldEqual) 16 | 17 | spec :: Spec Unit 18 | spec = 19 | describe "encoding-spec" do 20 | falseOrObjectTests 21 | blockTests 22 | 23 | falseOrObjectTests :: Spec Unit 24 | falseOrObjectTests = 25 | describe "FalseOrObject tests" do 26 | it "can decode FalseOrObject instances that are false" do 27 | let 28 | decodedFalse = (runExcept $ readJSON' "false") :: (Either (NonEmptyList ForeignError) (FalseOrObject SyncStatus)) 29 | decodedFalse `shouldEqual` (Right $ FalseOrObject Nothing) 30 | it "can decode FalseOrObject instances that are objects" do 31 | let 32 | decodedObj = runExcept $ readJSON' "{ \"startingBlock\": \"0x0\", \"currentBlock\": \"0x1\", \"highestBlock\": \"0x2\" }" 33 | decodedObj `shouldEqual` (Right $ FalseOrObject $ Just $ SyncStatus { startingBlock: fromInt 0, currentBlock: fromInt 1, highestBlock: fromInt 2 }) 34 | 35 | blockTests :: Spec Unit 36 | blockTests = 37 | describe "Block decoding tests" do 38 | it "can decode normal blocks" do 39 | let 40 | (decodedBlockE :: Either (NonEmptyList ForeignError) Block) = runExcept $ readJSON' blockPlaintext 41 | dBlock <- unwrap <$> either (throwError <<< error <<< show) pure decodedBlockE 42 | dBlock.nonce `shouldEqual` (Just $ upToHex "0x0000000000000000") 43 | dBlock.hash `shouldEqual` (Just $ upToHex "0x093ff26b85b5e3ac3e331f3d766a81990be76ec8ac79f62a81e30faa642dc26f") 44 | dBlock.timestamp `shouldEqual` fromInt 1507570522 45 | where 46 | -- this is block 1 on Eth mainnet 47 | blockPlaintext = "{\"difficulty\":\"0x1\",\"extraData\":\"0x0000000000000000000000000000000000000000000000000000000000000000759e3fae48d5abad53ab446f31ab3ae1531f2e4c0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000\",\"gasLimit\":\"0x8000000\",\"gasUsed\":\"0x0\",\"hash\":\"0x093ff26b85b5e3ac3e331f3d766a81990be76ec8ac79f62a81e30faa642dc26f\",\"logsBloom\":\"0x00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000\",\"miner\":\"0x0000000000000000000000000000000000000000\",\"mixHash\":\"0x0000000000000000000000000000000000000000000000000000000000000000\",\"nonce\":\"0x0000000000000000\",\"number\":\"0x0\",\"parentHash\":\"0x0000000000000000000000000000000000000000000000000000000000000000\",\"receiptsRoot\":\"0x56e81f171bcc55a6ff8345e692c0f86e5b48e01b996cadc001622fb5e363b421\",\"sha3Uncles\":\"0x1dcc4de8dec75d7aab85b567b6ccd41ad312451b948a7413f0a142fd40d49347\",\"size\":\"0x273\",\"stateRoot\":\"0xd3811ce828cfc6b07dbedfe073e1ef7e50bda2dac61a901e995c0f460a625cdd\",\"timestamp\":\"0x59dbb35a\",\"totalDifficulty\":\"0x1\",\"transactions\":[],\"transactionsRoot\":\"0x56e81f171bcc55a6ff8345e692c0f86e5b48e01b996cadc001622fb5e363b421\",\"uncles\":[]}" 48 | 49 | upToHex = unsafePartial fromJust <<< mkHexString 50 | 51 | newtype KovanBlock = KovanBlock 52 | { difficulty :: BigNumber 53 | , extraData :: HexString 54 | , gasLimit :: BigNumber 55 | , gasUsed :: BigNumber 56 | , hash :: Maybe HexString 57 | , logsBloom :: Maybe HexString 58 | , author :: HexString 59 | , sealFields :: Array HexString 60 | , number :: Maybe BigNumber 61 | , parentHash :: HexString 62 | , receiptsRoot :: HexString 63 | , sha3Uncles :: HexString 64 | , size :: BigNumber 65 | , stateRoot :: HexString 66 | , timestamp :: BigNumber 67 | , totalDifficulty :: BigNumber 68 | , transactions :: Array HexString 69 | , transactionsRoot :: HexString 70 | , uncles :: Array HexString 71 | } 72 | -------------------------------------------------------------------------------- /src/Network/Ethereum/Web3/Solidity/Internal.purs: -------------------------------------------------------------------------------- 1 | module Network.Ethereum.Web3.Solidity.Internal 2 | ( class RecordFieldsIso 3 | , _toRecord 4 | , fromRecord 5 | , toRecord 6 | , class GRecordFieldsIso 7 | , gToRecord 8 | , gFromRecord 9 | ) where 10 | 11 | import Prelude 12 | 13 | import Data.Functor.Tagged (Tagged, untagged, tagged) 14 | import Data.Generic.Rep (class Generic, Argument(..), Constructor(..), NoArguments(..), Product(..), from, to) 15 | import Data.Identity (Identity(..)) 16 | import Data.Newtype (un) 17 | import Data.Symbol (class IsSymbol) 18 | import Network.Ethereum.Web3.Solidity.Vector (Vector) 19 | import Prim.Row as Row 20 | import Record (disjointUnion) 21 | import Record as Record 22 | import Record.Builder (Builder) 23 | import Record.Builder as Builder 24 | import Type.Proxy (Proxy(..)) 25 | import Unsafe.Coerce (unsafeCoerce) 26 | 27 | class GRecordFieldsIso rep from to | from rep -> to, to rep -> from where 28 | gToRecord :: rep -> Builder { | from } { | to } 29 | gFromRecord :: Record to -> rep 30 | 31 | instance GRecordFieldsIso NoArguments from from where 32 | gToRecord _ = identity 33 | gFromRecord _ = NoArguments 34 | 35 | else instance 36 | ( IsSymbol name 37 | , GRecordFieldsIso a from to 38 | ) => 39 | GRecordFieldsIso (Constructor name a) from to where 40 | gToRecord (Constructor a) = gToRecord a 41 | gFromRecord r = Constructor (gFromRecord r) 42 | 43 | else instance 44 | ( GRecordFieldsIso a () ato 45 | , GRecordFieldsIso b () bto 46 | , Row.Union ato bto to 47 | , Row.Union to from to 48 | , Row.Nub to to 49 | ) => 50 | GRecordFieldsIso (Product a b) from to where 51 | gToRecord (Product as bs) = 52 | let 53 | r = Builder.buildFromScratch (gToRecord as) `disjointUnion` Builder.buildFromScratch (gToRecord bs) 54 | in 55 | Builder.merge r 56 | 57 | gFromRecord r = 58 | let 59 | as = gFromRecord (unsafeCoerce r :: Record ato) 60 | bs = gFromRecord (unsafeCoerce r :: Record bto) 61 | in 62 | Product as bs 63 | 64 | else instance 65 | ( RecordFieldsIso a from to 66 | ) => 67 | GRecordFieldsIso (Argument a) from to where 68 | gToRecord (Argument a) = _toRecord a 69 | gFromRecord r = Argument $ fromRecord r 70 | 71 | class RecordFieldsIso a from to | from a -> to, a to -> from where 72 | _toRecord :: a -> Builder { | from } { | to } 73 | fromRecord :: Record to -> a 74 | 75 | instance 76 | ( IsSymbol s 77 | , Row.Cons s (Array (Record to)) from to' 78 | , Row.Lacks s from 79 | , Generic a rep 80 | , GRecordFieldsIso rep () to 81 | ) => 82 | RecordFieldsIso (Tagged s (Array a)) from to' where 83 | _toRecord a = 84 | Builder.insert (Proxy @s) $ map 85 | (Builder.buildFromScratch <<< (gToRecord <<< from)) 86 | (untagged a) 87 | fromRecord r = 88 | tagged $ map (to <<< gFromRecord) $ Record.get (Proxy @s) r 89 | 90 | else instance 91 | ( IsSymbol s 92 | , Row.Cons s (Vector n (Record to)) from to' 93 | , Row.Lacks s from 94 | , Generic a rep 95 | , GRecordFieldsIso rep () to 96 | ) => 97 | RecordFieldsIso (Tagged s (Vector n a)) from to' where 98 | _toRecord a = 99 | Builder.insert (Proxy @s) $ map 100 | (Builder.buildFromScratch <<< (gToRecord <<< from)) 101 | (untagged a) 102 | fromRecord r = 103 | tagged $ map (to <<< gFromRecord) $ Record.get (Proxy @s) r 104 | 105 | else instance 106 | ( IsSymbol s 107 | , Row.Cons s a from to 108 | , Row.Lacks s from 109 | ) => 110 | RecordFieldsIso (Tagged s (Identity a)) from to where 111 | _toRecord a = Builder.insert (Proxy @s) (un Identity $ untagged a) 112 | fromRecord r = tagged $ Identity $ Record.get (Proxy @s) r 113 | 114 | else instance 115 | ( IsSymbol s 116 | , Row.Cons s (Record to) from to' 117 | , Row.Lacks s from 118 | , Generic a rep 119 | , GRecordFieldsIso rep () to 120 | ) => 121 | RecordFieldsIso (Tagged s a) from to' where 122 | _toRecord a = Builder.insert (Proxy @s) $ 123 | Builder.buildFromScratch (gToRecord $ from $ untagged a) 124 | fromRecord r = tagged $ to $ gFromRecord $ Record.get (Proxy @s) r 125 | 126 | else instance 127 | ( Generic a arep 128 | , GRecordFieldsIso arep from to 129 | ) => 130 | RecordFieldsIso a from to where 131 | _toRecord a = 132 | gToRecord $ from a 133 | fromRecord r = 134 | to $ gFromRecord r 135 | 136 | toRecord 137 | :: forall a fields 138 | . RecordFieldsIso a () fields 139 | => a 140 | -> Record fields 141 | toRecord a = 142 | Builder.buildFromScratch $ _toRecord a 143 | -------------------------------------------------------------------------------- /src/Network/Ethereum/Web3/Solidity/Event.purs: -------------------------------------------------------------------------------- 1 | module Network.Ethereum.Web3.Solidity.Event 2 | ( class DecodeEvent 3 | , decodeEvent 4 | , class ArrayParser 5 | , arrayParser 6 | , class GArrayParser 7 | , gArrayParser 8 | , class IndexedEvent 9 | , isAnonymous 10 | ) where 11 | 12 | import Prelude 13 | 14 | import Control.Monad.Error.Class (throwError) 15 | import Data.Array (uncons) 16 | import Data.Bifunctor (lmap) 17 | import Data.Either (Either(..), note) 18 | import Data.Generic.Rep (class Generic, Argument(..), Constructor(..), NoArguments(..), Product(..), to) 19 | import Data.Maybe (Maybe(..)) 20 | import Data.Newtype (class Newtype, wrap) 21 | import Data.Tuple (Tuple(..)) 22 | import Network.Ethereum.Types (HexString) 23 | import Network.Ethereum.Web3.Solidity.AbiEncoding (class ABIDecode, class ABIEncode, abiDecode) 24 | import Network.Ethereum.Web3.Solidity.Internal (class RecordFieldsIso, toRecord) 25 | import Network.Ethereum.Web3.Types (Change(..), Web3Error(..)) 26 | import Prim.Row as Row 27 | import Record (disjointUnion) 28 | import Type.Proxy (Proxy(..)) 29 | 30 | -------------------------------------------------------------------------------- 31 | -- Array Parsers 32 | -------------------------------------------------------------------------------- 33 | class ArrayParser a where 34 | arrayParser :: Array HexString -> Either Web3Error (Tuple a (Array HexString)) 35 | 36 | instance (Generic a rep, GArrayParser rep) => ArrayParser a where 37 | arrayParser hx = do 38 | Tuple a rest <- gArrayParser hx 39 | case rest of 40 | [] -> pure $ Tuple (to a) rest 41 | _ -> throwError $ ParserError "too many arguments to arrayParser" 42 | 43 | class GArrayParser rep where 44 | gArrayParser :: Array HexString -> Either Web3Error (Tuple rep (Array HexString)) 45 | 46 | instance GArrayParser NoArguments where 47 | gArrayParser as = pure (Tuple NoArguments as) 48 | 49 | else instance ABIDecode a => GArrayParser (Argument a) where 50 | gArrayParser hxs = case uncons hxs of 51 | Nothing -> Left $ ParserError "no arguments found for arrayParser" 52 | Just { head, tail } -> do 53 | res <- lmap (ParserError <<< show) <<< abiDecode $ head 54 | pure $ Tuple (Argument res) tail 55 | 56 | else instance (GArrayParser as, GArrayParser bs) => GArrayParser (Product as bs) where 57 | gArrayParser hxs = do 58 | Tuple a rest <- gArrayParser hxs 59 | Tuple b rest' <- gArrayParser rest 60 | pure $ Tuple (Product a b) rest' 61 | 62 | else instance GArrayParser as => GArrayParser (Constructor name as) where 63 | gArrayParser hxs = do 64 | Tuple a rest <- gArrayParser hxs 65 | pure $ Tuple (Constructor a) rest 66 | 67 | -------------------------------------------------------------------------------- 68 | -- | Event Parsers 69 | -------------------------------------------------------------------------------- 70 | data Event i ni = Event i ni 71 | 72 | parseChange 73 | :: forall a b 74 | . ArrayParser a 75 | => ABIDecode b 76 | => Change 77 | -> Boolean 78 | -> Either Web3Error (Event a b) 79 | parseChange (Change change) anonymous = do 80 | topics <- 81 | if anonymous then pure change.topics 82 | else note (ParserError "No topics found") (_.tail <$> uncons change.topics) 83 | Tuple a _ <- arrayParser topics 84 | b <- lmap (ParserError <<< show) $ abiDecode change.data 85 | pure $ Event a b 86 | 87 | combineChange 88 | :: forall afields a bfields b c cfields 89 | . RecordFieldsIso a () afields 90 | => RecordFieldsIso b () bfields 91 | => Row.Union afields bfields cfields 92 | => Row.Nub cfields cfields 93 | => Newtype c (Record cfields) 94 | => Event a b 95 | -> c 96 | combineChange (Event a b) = 97 | wrap $ disjointUnion (toRecord a :: Record afields) (toRecord b :: Record bfields) 98 | 99 | class IndexedEvent :: forall k1 k2 k3. k1 -> k2 -> k3 -> Constraint 100 | class IndexedEvent a b c | c -> a b where 101 | isAnonymous :: Proxy c -> Boolean 102 | 103 | class DecodeEvent :: forall k1 k2. k1 -> k2 -> Type -> Constraint 104 | class 105 | IndexedEvent a b c <= 106 | DecodeEvent a b c 107 | | c -> a b where 108 | decodeEvent :: Change -> Either Web3Error c 109 | 110 | instance 111 | ( ArrayParser a 112 | , RecordFieldsIso a () afields 113 | , ABIEncode a 114 | , RecordFieldsIso b () bfields 115 | , ABIDecode b 116 | , Row.Union afields bfields cfields 117 | , Row.Nub cfields cfields 118 | , Newtype c (Record cfields) 119 | , IndexedEvent a b c 120 | ) => 121 | DecodeEvent a b c where 122 | decodeEvent change = do 123 | let anonymous = isAnonymous (Proxy :: Proxy c) 124 | (e :: Event a b) <- parseChange change anonymous 125 | pure $ combineChange e 126 | -------------------------------------------------------------------------------- /src/Network/Ethereum/Web3/Types/TokenUnit.purs: -------------------------------------------------------------------------------- 1 | module Network.Ethereum.Web3.Types.TokenUnit 2 | ( class TokenUnit 3 | , fromMinorUnit 4 | , toMinorUnit 5 | , class TokenUnitSpec 6 | , divider 7 | , TokenK 8 | , TokenUnitK 9 | , Value 10 | , convert 11 | , formatValue 12 | , mkValue 13 | , generator 14 | , NoPay 15 | , MinorUnit 16 | , MinorUnitE3 17 | , MinorUnitE6 18 | , MinorUnitE9 19 | , MinorUnitE12 20 | , MinorUnitE15 21 | , MinorUnitE18 22 | , MinorUnitE21 23 | ) where 24 | 25 | import Prelude 26 | 27 | import Control.Monad.Gen (class MonadGen) 28 | import Data.Maybe (fromJust) 29 | import Data.Ring.Module (class LeftModule) 30 | import Data.String (joinWith) 31 | import Data.Unfoldable (replicate) 32 | import Network.Ethereum.Core.BigNumber (BigNumber, decimal, fromInt, fromStringAs) 33 | import Network.Ethereum.Core.BigNumber as BigNumber 34 | import Partial.Unsafe (unsafePartial) 35 | import Simple.JSON (class ReadForeign, class WriteForeign, writeImpl) 36 | import Type.Proxy (Proxy(..)) 37 | 38 | data TokenK 39 | 40 | data TokenUnitK 41 | 42 | -- | A value of some token in specific denomination 43 | newtype Value (a :: TokenUnitK) = Value BigNumber 44 | 45 | derive newtype instance Eq (Value a) 46 | derive newtype instance Ord (Value a) 47 | derive newtype instance Show (Value a) 48 | derive newtype instance ReadForeign (Value a) 49 | 50 | generator :: forall m a proxy. MonadGen m => proxy a -> m (Value a) 51 | generator _ = Value <$> BigNumber.generator 52 | 53 | instance WriteForeign (Value (NoPay t)) where 54 | writeImpl _ = writeImpl (zero :: BigNumber) 55 | else instance WriteForeign (Value a) where 56 | writeImpl (Value x) = writeImpl x 57 | 58 | instance TokenUnitSpec a => Semigroup (Value a) where 59 | append a b = Value (unValue a `add` unValue b) 60 | 61 | instance TokenUnitSpec a => Monoid (Value a) where 62 | mempty = mkValue zero 63 | 64 | instance TokenUnitSpec a => LeftModule (Value a) Int where 65 | mzeroL = mkValue zero 66 | maddL (Value a) (Value b) = Value $ a + b 67 | msubL (Value a) (Value b) = Value $ a - b 68 | mmulL a (Value b) = Value $ fromInt a * b 69 | 70 | instance TokenUnitSpec a => TokenUnit (Value a) where 71 | fromMinorUnit = Value 72 | toMinorUnit = unValue 73 | 74 | unValue :: forall a. Value a -> BigNumber 75 | unValue (Value a) = a 76 | 77 | class TokenUnit :: Type -> Constraint 78 | class TokenUnit a where 79 | fromMinorUnit :: BigNumber -> a 80 | toMinorUnit :: a -> BigNumber 81 | 82 | -- | Convert between two denominations 83 | convert :: forall a b. TokenUnit a => TokenUnit b => a -> b 84 | convert = fromMinorUnit <<< toMinorUnit 85 | 86 | class TokenUnitSpec (a :: TokenUnitK) where 87 | divider :: forall proxy. proxy a -> BigNumber 88 | 89 | formatValue :: forall a. TokenUnitSpec a => Value a -> String 90 | formatValue v = show $ toMinorUnit v `div` divider (Proxy :: Proxy a) 91 | 92 | -- | Convert a big number into value, first using `floor` function to take the integer part 93 | mkValue :: forall a. TokenUnitSpec a => BigNumber -> Value a 94 | mkValue = Value <<< (mul (divider (Proxy :: Proxy a))) 95 | 96 | foreign import data NoPay :: TokenK -> TokenUnitK 97 | 98 | instance TokenUnitSpec (NoPay t) where 99 | divider = const zero 100 | 101 | foreign import data MinorUnit :: TokenK -> TokenUnitK 102 | 103 | instance TokenUnitSpec (MinorUnit t) where 104 | divider = createDivider 0 105 | 106 | foreign import data MinorUnitE3 :: TokenK -> TokenUnitK 107 | 108 | instance TokenUnitSpec (MinorUnitE3 t) where 109 | divider = createDivider 3 110 | 111 | foreign import data MinorUnitE6 :: TokenK -> TokenUnitK 112 | 113 | instance TokenUnitSpec (MinorUnitE6 t) where 114 | divider = createDivider 6 115 | 116 | foreign import data MinorUnitE9 :: TokenK -> TokenUnitK 117 | 118 | instance TokenUnitSpec (MinorUnitE9 t) where 119 | divider = createDivider 9 120 | 121 | foreign import data MinorUnitE12 :: TokenK -> TokenUnitK 122 | 123 | instance TokenUnitSpec (MinorUnitE12 t) where 124 | divider = createDivider 12 125 | 126 | foreign import data MinorUnitE15 :: TokenK -> TokenUnitK 127 | 128 | instance TokenUnitSpec (MinorUnitE15 t) where 129 | divider = createDivider 15 130 | 131 | foreign import data MinorUnitE18 :: TokenK -> TokenUnitK 132 | 133 | instance TokenUnitSpec (MinorUnitE18 t) where 134 | divider = createDivider 18 135 | 136 | foreign import data MinorUnitE21 :: TokenK -> TokenUnitK 137 | 138 | instance TokenUnitSpec (MinorUnitE21 t) where 139 | divider = createDivider 21 140 | 141 | createDivider :: forall a. Int -> a -> BigNumber 142 | createDivider denomination _ = unsafeConvert $ "1" <> joinWith "" (replicate denomination "0") 143 | where 144 | unsafeConvert :: String -> BigNumber 145 | unsafeConvert a = unsafePartial fromJust <<< fromStringAs decimal $ a 146 | -------------------------------------------------------------------------------- /src/Network/Ethereum/Web3/Contract.purs: -------------------------------------------------------------------------------- 1 | module Network.Ethereum.Web3.Contract 2 | ( class EventFilter 3 | , eventFilter 4 | , event 5 | , class CallMethod 6 | , call 7 | , class TxMethod 8 | , sendTx 9 | , deployContract 10 | , mkDataField 11 | ) where 12 | 13 | import Prelude 14 | 15 | import Control.Monad.Error.Class (throwError) 16 | import Data.Bifunctor (lmap) 17 | import Data.Either (Either(..)) 18 | import Data.Functor.Tagged (Tagged, untagged) 19 | import Data.Lens ((.~), (%~), (?~)) 20 | import Data.Maybe (Maybe(..)) 21 | import Data.Symbol (class IsSymbol, reflectSymbol) 22 | import Effect.Exception (error) 23 | import Network.Ethereum.Core.Keccak256 (toSelector) 24 | import Network.Ethereum.Types (Address, HexString) 25 | import Network.Ethereum.Web3.Api (eth_call, eth_sendTransaction) 26 | import Network.Ethereum.Web3.Contract.Events (MultiFilterStreamState(..), event', FilterStreamState, ChangeReceipt, EventHandler) 27 | import Network.Ethereum.Web3.Solidity (class ABIDecode, class ABIEncode, class DecodeEvent, class RecordFieldsIso, fromRecord) 28 | import Network.Ethereum.Web3.Solidity.AbiEncoding (abiDecode, abiEncode) 29 | import Network.Ethereum.Web3.Types (class TokenUnit, CallError(..), ChainCursor, ETHER, Filter, NoPay, TransactionOptions, Value, Web3, _data, _value, convert) 30 | import Type.Proxy (Proxy(..)) 31 | 32 | class EventFilter :: forall k. k -> Constraint 33 | class EventFilter e where 34 | -- | Event filter structure used by low-level subscription methods 35 | eventFilter :: Proxy e -> Address -> Filter e 36 | 37 | -- | run `event'` one block at a time. 38 | event 39 | :: forall e i ni 40 | . DecodeEvent i ni e 41 | => Filter e 42 | -> EventHandler Web3 e 43 | -> Web3 (Either (FilterStreamState e) ChangeReceipt) 44 | event filter handler = do 45 | eRes <- event' { ev: filter } { ev: handler } { windowSize: 0, trailBy: 0 } 46 | pure $ lmap f eRes 47 | where 48 | f :: MultiFilterStreamState (ev :: Filter e) -> FilterStreamState e 49 | f (MultiFilterStreamState { currentBlock, windowSize, trailBy, filters }) = 50 | let 51 | { ev: filter } = filters 52 | in 53 | { currentBlock 54 | , windowSize 55 | , trailBy 56 | , initialFilter: filter 57 | } 58 | 59 | -------------------------------------------------------------------------------- 60 | -- * Methods 61 | -------------------------------------------------------------------------------- 62 | -- | Class paramaterized by values which are ABIEncodable, allowing the templating of 63 | -- | of a transaction with this value as the payload. 64 | class TxMethod (selector :: Symbol) a where 65 | -- | Send a transaction for given contract `Address`, value and input data 66 | sendTx 67 | :: forall u 68 | . TokenUnit (Value (u ETHER)) 69 | => IsSymbol selector 70 | => TransactionOptions u 71 | -> Tagged selector a 72 | -> Web3 HexString 73 | 74 | -- ^ `Web3` wrapped tx hash 75 | class CallMethod (selector :: Symbol) a b where 76 | -- | Constant call given contract `Address` in mode and given input data 77 | call 78 | :: IsSymbol selector 79 | => TransactionOptions NoPay 80 | -> ChainCursor 81 | -> Tagged selector a 82 | -> Web3 (Either CallError b) 83 | 84 | -- ^ `Web3` wrapped result 85 | instance ABIEncode a => TxMethod s a where 86 | sendTx = _sendTransaction 87 | 88 | instance (ABIEncode a, ABIDecode b) => CallMethod s a b where 89 | call = _call 90 | 91 | _sendTransaction 92 | :: forall a u selector 93 | . IsSymbol selector 94 | => ABIEncode a 95 | => TokenUnit (Value (u ETHER)) 96 | => TransactionOptions u 97 | -> Tagged selector a 98 | -> Web3 HexString 99 | _sendTransaction txOptions dat = do 100 | let 101 | sel = toSelector <<< reflectSymbol $ (Proxy :: Proxy selector) 102 | eth_sendTransaction $ txdata $ sel <> (abiEncode <<< untagged $ dat) 103 | where 104 | txdata d = 105 | txOptions # _data .~ Just d 106 | # _value 107 | %~ map convert 108 | 109 | _call 110 | :: forall a b selector 111 | . IsSymbol selector 112 | => ABIEncode a 113 | => ABIDecode b 114 | => TransactionOptions NoPay 115 | -> ChainCursor 116 | -> Tagged selector a 117 | -> Web3 (Either CallError b) 118 | _call txOptions cursor dat = do 119 | let 120 | sig = reflectSymbol $ (Proxy :: Proxy selector) 121 | 122 | sel = toSelector sig 123 | 124 | fullData = sel <> (abiEncode <<< untagged $ dat) 125 | res <- eth_call (txdata $ sel <> (abiEncode <<< untagged $ dat)) cursor 126 | case abiDecode res of 127 | Left err -> 128 | if res == mempty then 129 | pure <<< Left 130 | $ NullStorageError 131 | { signature: sig 132 | , _data: fullData 133 | } 134 | else 135 | throwError $ error $ show err 136 | Right x -> pure $ Right x 137 | where 138 | txdata d = txOptions # _data .~ Just d 139 | 140 | deployContract 141 | :: forall a t 142 | . ABIEncode a 143 | => TransactionOptions NoPay 144 | -> HexString 145 | -> Tagged t a 146 | -> Web3 HexString 147 | deployContract txOptions deployByteCode args = 148 | let 149 | txdata = 150 | txOptions # _data ?~ deployByteCode <> abiEncode (untagged args) 151 | # _value 152 | %~ map convert 153 | in 154 | eth_sendTransaction txdata 155 | 156 | mkDataField 157 | :: forall selector a fields 158 | . IsSymbol selector 159 | => RecordFieldsIso a () fields 160 | => ABIEncode a 161 | => Proxy (Tagged selector a) 162 | -> Record fields 163 | -> HexString 164 | mkDataField _ r = 165 | let 166 | sig = reflectSymbol (Proxy :: Proxy selector) 167 | 168 | sel = toSelector sig 169 | 170 | args = fromRecord r :: a 171 | in 172 | sel <> abiEncode args 173 | -------------------------------------------------------------------------------- /test/web3/Web3Spec/Live/RPCSpec.purs: -------------------------------------------------------------------------------- 1 | module Web3Spec.Live.RPCSpec (spec) where 2 | 3 | import Prelude 4 | import Data.Array ((!!), last) 5 | import Node.Buffer.Immutable as B 6 | import Node.Encoding (Encoding(UTF8)) 7 | import Data.Either (isRight) 8 | import Data.Lens ((?~), (%~)) 9 | import Data.Maybe (Maybe(..), fromJust) 10 | import Data.Tuple (Tuple(..)) 11 | import Effect.Aff (Aff) 12 | import Network.Ethereum.Core.HexString as Hex 13 | import Network.Ethereum.Core.Keccak256 (keccak256) 14 | import Network.Ethereum.Core.Signatures as Sig 15 | import Network.Ethereum.Web3 (Block(..), ChainCursor(..), Provider, TransactionReceipt(..), _from, _to, _value, convert, defaultTransactionOptions, fromMinorUnit, mkHexString, runWeb3) 16 | import Network.Ethereum.Web3.Api as Api 17 | import Partial.Unsafe (unsafePartial) 18 | import Test.Spec (SpecT, describe, it) 19 | import Test.Spec.Assertions (shouldEqual, shouldSatisfy) 20 | import Web3Spec.Live.Utils (assertWeb3, pollTransactionReceipt) 21 | 22 | spec :: Provider -> SpecT Aff Unit Aff Unit 23 | spec provider = 24 | describe "It should be able to test all the web3 endpoints live" do 25 | it "Can get the network version" do 26 | eRes <- runWeb3 provider $ Api.net_version 27 | eRes `shouldSatisfy` isRight 28 | it "Can call net_listening" do 29 | eRes <- runWeb3 provider $ Api.net_listening 30 | eRes `shouldSatisfy` isRight 31 | it "Can call net_getPeerCount" do 32 | eRes <- runWeb3 provider $ Api.net_getPeerCount 33 | eRes `shouldSatisfy` isRight 34 | it "Can call eth_protocolVersion" do 35 | eRes <- runWeb3 provider $ Api.eth_protocolVersion 36 | eRes `shouldSatisfy` isRight 37 | it "Can call eth_getSyncing" do 38 | eRes <- runWeb3 provider $ Api.eth_getSyncing 39 | eRes `shouldSatisfy` isRight 40 | it "Can call eth_coinbase" do 41 | eRes <- runWeb3 provider $ Api.eth_coinbase 42 | eRes `shouldSatisfy` isRight 43 | it "Can call eth_mining" do 44 | eRes <- runWeb3 provider $ Api.eth_mining 45 | eRes `shouldSatisfy` isRight 46 | it "Can call eth_hashrate" do 47 | eRes <- runWeb3 provider $ Api.eth_hashrate 48 | eRes `shouldSatisfy` isRight 49 | it "Can call eth_blockNumber" do 50 | eRes <- runWeb3 provider $ Api.eth_blockNumber 51 | eRes `shouldSatisfy` isRight 52 | it "Can call eth_accounts and eth_getBalance" do 53 | eRes <- 54 | runWeb3 provider 55 | $ do 56 | accounts <- Api.eth_getAccounts 57 | Api.eth_getBalance (unsafePartial fromJust $ accounts !! 0) Latest 58 | eRes `shouldSatisfy` isRight 59 | it "Can call eth_getTransactionCount" do 60 | eRes <- 61 | runWeb3 provider do 62 | accounts <- Api.eth_getAccounts 63 | Api.eth_getTransactionCount (unsafePartial fromJust $ accounts !! 0) Latest 64 | eRes `shouldSatisfy` isRight 65 | it "Can call eth_getBlockByNumber, eth_getBlockTransactionCountByHash, getBlockTransactionCountByNumber" do 66 | Tuple count1 count2 <- 67 | assertWeb3 provider do 68 | bn <- Api.eth_blockNumber 69 | Block block <- Api.eth_getBlockByNumber (BN bn) 70 | let 71 | bHash = unsafePartial fromJust block.hash 72 | count1 <- Api.eth_getBlockTransactionCountByHash bHash 73 | count2 <- Api.eth_getBlockTransactionCountByNumber (BN bn) 74 | pure $ Tuple count1 count2 75 | count1 `shouldEqual` count2 76 | it "Can call eth_getUncleCountByBlockHash eth_getUncleCountByBlockNumber" do 77 | Tuple count1 count2 <- 78 | assertWeb3 provider do 79 | bn <- Api.eth_blockNumber 80 | Block block <- Api.eth_getBlockByNumber (BN bn) 81 | let 82 | bHash = unsafePartial fromJust block.hash 83 | count1 <- Api.eth_getUncleCountByBlockHash bHash 84 | count2 <- Api.eth_getUncleCountByBlockNumber (BN bn) 85 | pure $ Tuple count1 count2 86 | count1 `shouldEqual` count2 87 | it "Can call eth_getBlockByHash" do 88 | eRes <- 89 | runWeb3 provider do 90 | bn <- Api.eth_blockNumber 91 | Block block <- Api.eth_getBlockByNumber (BN bn) 92 | let 93 | bHash = unsafePartial fromJust block.hash 94 | Api.eth_getBlockByHash bHash 95 | eRes `shouldSatisfy` isRight 96 | -- TODO: validate this with eth-core lib 97 | it "Can call personal_sign, personal_ecRecover, and they should coincide with eth-core" do 98 | let 99 | msgBody = unsafePartial fromJust $ mkHexString "1234" 100 | 101 | fullHashedMessageBS = keccak256 <<< makeRidiculousEthereumMessage $ msgBody 102 | { signer, signer', signatureHex } <- 103 | assertWeb3 provider do 104 | accounts <- Api.eth_getAccounts 105 | let 106 | signer = unsafePartial fromJust $ accounts !! 0 107 | signatureHex <- Api.personal_sign msgBody signer (Just "password123") 108 | signer' <- Api.personal_ecRecover msgBody signatureHex 109 | pure $ { signer, signer', signatureHex } 110 | signer `shouldEqual` signer' 111 | -- make sure that we can recover the signature in purescript natively 112 | let 113 | rsvSignature = case signatureFromByteString <<< Hex.toBuffer $ signatureHex of 114 | Sig.Signature sig -> Sig.Signature sig { v = sig.v - 27 } 115 | Sig.publicToAddress (Sig.recoverSender fullHashedMessageBS rsvSignature) `shouldEqual` signer 116 | it "Can call eth_estimateGas" do 117 | eRes <- runWeb3 provider $ Api.eth_estimateGas (defaultTransactionOptions # _value %~ map convert) 118 | eRes `shouldSatisfy` isRight 119 | it "Can call eth_getTransactionByBlockHashAndIndex eth_getBlockTransactionByBlockNumberAndIndex" do 120 | txHash <- 121 | assertWeb3 provider do 122 | accounts <- Api.eth_getAccounts 123 | let 124 | sender = unsafePartial fromJust $ accounts !! 0 125 | 126 | receiver = unsafePartial fromJust $ accounts !! 1 127 | 128 | txOpts = 129 | defaultTransactionOptions # _from ?~ sender 130 | # _to 131 | ?~ receiver 132 | # _value 133 | ?~ fromMinorUnit one 134 | Api.eth_sendTransaction txOpts 135 | TransactionReceipt txReceipt <- pollTransactionReceipt provider txHash pure 136 | Tuple tx tx' <- 137 | assertWeb3 provider do 138 | tx <- Api.eth_getTransactionByBlockHashAndIndex txReceipt.blockHash zero 139 | tx' <- Api.eth_getTransactionByBlockNumberAndIndex (BN txReceipt.blockNumber) zero 140 | pure $ Tuple tx tx' 141 | tx `shouldEqual` tx' 142 | 143 | signatureFromByteString :: B.ImmutableBuffer -> Sig.Signature 144 | signatureFromByteString bfr = 145 | let 146 | 147 | r = Hex.fromBuffer $ B.slice 0 32 bfr 148 | 149 | s = Hex.fromBuffer $ B.slice 32 64 bfr 150 | 151 | v = unsafePartial fromJust $ last $ B.toArray bfr 152 | in 153 | Sig.Signature { r, s, v } 154 | 155 | makeRidiculousEthereumMessage :: Hex.HexString -> Hex.HexString 156 | makeRidiculousEthereumMessage s = 157 | let 158 | prefix = 159 | Hex.fromBuffer 160 | $ B.fromString 161 | ( "\x19" -- NOTE: 19 in hexadecimal is 25 162 | 163 | <> "Ethereum Signed Message:\n" -- NOTE: length of this string is 25 164 | <> show (Hex.numberOfBytes s) 165 | ) 166 | UTF8 167 | in 168 | prefix <> s 169 | -------------------------------------------------------------------------------- /test/web3/Web3Spec/Encoding/GenericSpec.purs: -------------------------------------------------------------------------------- 1 | module Web3Spec.Encoding.GenericSpec (spec) where 2 | 3 | import Prelude 4 | 5 | import Data.Either (Either, isRight) 6 | import Data.Functor.Tagged (Tagged, tagged) 7 | import Data.Generic.Rep (class Generic) 8 | import Data.Identity (Identity(..)) 9 | import Data.Maybe (fromJust) 10 | import Effect.Class (liftEffect) 11 | import Network.Ethereum.Core.HexString (HexString, mkHexString) 12 | import Network.Ethereum.Web3.Solidity (BytesN, Tuple2(..), Tuple3(..), UIntN) 13 | import Network.Ethereum.Web3.Solidity.AbiEncoding (abiDecode) 14 | import Network.Ethereum.Web3.Solidity.Internal (toRecord) 15 | import Parsing (ParseError) 16 | import Partial.Unsafe (unsafePartial) 17 | import Record.Builder (build, merge) 18 | import Test.QuickCheck (quickCheck, (===)) 19 | import Test.Spec (Spec, describe, it) 20 | import Test.Spec.Assertions (shouldSatisfy) 21 | 22 | spec :: Spec Unit 23 | spec = 24 | describe "encoding-spec for generics" do 25 | toRecordFieldsSpec 26 | 27 | toRecordFieldsSpec :: Spec Unit 28 | toRecordFieldsSpec = 29 | describe "test RecordFieldsIso class" do 30 | 31 | it "Can parse nested tuples: " $ 32 | let 33 | eRes :: Either ParseError Nested 34 | eRes = abiDecode nestedTupleBytes 35 | in 36 | (toRecord <$> eRes) `shouldSatisfy` isRight 37 | 38 | it "pass _toRecord basic test" $ liftEffect do 39 | quickCheck $ \(x :: { a :: Int, b :: Int, c :: String, d :: String }) -> 40 | let 41 | as = Tuple2 (tagged $ Identity x.a) (tagged $ Identity x.b) :: Tuple2 (Tagged "a" (Identity Int)) (Tagged "b" (Identity Int)) 42 | bs = Tuple2 (tagged $ Identity x.c) (tagged $ Identity x.d) :: Tuple2 (Tagged "c" (Identity String)) (Tagged "d" (Identity String)) 43 | cs = Tuple2 (tagged as :: Tagged "as" _) (tagged bs :: Tagged "bs" _) 44 | --q = from as :: Int 45 | in 46 | toRecord cs 47 | === 48 | { as: { a: x.a, b: x.b } 49 | , bs: { c: x.c, d: x.d } 50 | } 51 | 52 | it "pass _toRecord basic test" $ liftEffect do 53 | quickCheck $ \(x :: { a :: Int, b :: Int, c :: String, d :: String, e :: Char }) -> 54 | let 55 | as = Tuple3 (tagged $ Identity x.a) (tagged $ Identity x.d) (tagged $ Identity x.e) :: Tuple3 (Tagged "a" (Identity Int)) (Tagged "d" (Identity String)) (Tagged "e" (Identity Char)) 56 | in 57 | WeirdTuple (toRecord as) 58 | === 59 | WeirdTuple 60 | { a: x.a 61 | , d: x.d 62 | , e: x.e 63 | } 64 | 65 | it "passes the merging test" $ liftEffect do 66 | quickCheck $ \(x :: { a :: Int, b :: Int, c :: String, d :: String, e :: Char }) -> 67 | let 68 | as = Tuple3 (tagged $ Identity x.a) (tagged $ Identity x.d) (tagged $ Identity x.e) :: Tuple3 (Tagged "a" (Identity Int)) (Tagged "d" (Identity String)) (Tagged "e" (Identity Char)) 69 | 70 | as' = Tuple2 (tagged $ Identity x.b) (tagged $ Identity x.c) :: Tuple2 (Tagged "b" (Identity Int)) (Tagged "c" (Identity String)) 71 | 72 | c = CombinedTuple $ build (merge (toRecord as)) (toRecord as') 73 | in 74 | c === CombinedTuple x 75 | 76 | -------------------------------------------------------------------------------- 77 | 78 | newtype WeirdTuple = WeirdTuple { a :: Int, d :: String, e :: Char } 79 | 80 | derive instance Generic WeirdTuple _ 81 | derive newtype instance Show WeirdTuple 82 | derive newtype instance Eq WeirdTuple 83 | 84 | newtype OtherTuple = OtherTuple { b :: Int, c :: String } 85 | 86 | derive instance Generic OtherTuple _ 87 | derive newtype instance Show OtherTuple 88 | derive newtype instance Eq OtherTuple 89 | 90 | newtype CombinedTuple = CombinedTuple { a :: Int, b :: Int, c :: String, d :: String, e :: Char } 91 | 92 | derive instance Generic CombinedTuple _ 93 | derive newtype instance Show CombinedTuple 94 | derive newtype instance Eq CombinedTuple 95 | 96 | type NestedRec = 97 | { x :: { a1 :: UIntN 256, a2 :: String } 98 | , y :: { b1 :: Array String, b2 :: BytesN 32 } 99 | , z :: 100 | Array { a :: { a1 :: UIntN 256, a2 :: String }, b :: { b1 :: Array String, b2 :: BytesN 32 } } 101 | } 102 | 103 | type Nested = Tuple3 104 | (Tagged "x" (Tuple2 (Tagged "a1" (Identity (UIntN 256))) (Tagged "a2" (Identity String)))) 105 | ( Tagged "y" 106 | (Tuple2 (Tagged "b1" (Identity (Array String))) (Tagged "b2" (Identity (BytesN 32)))) 107 | ) 108 | ( Tagged "z" 109 | ( Array 110 | ( Tuple2 111 | ( Tagged "a" 112 | (Tuple2 (Tagged "a1" (Identity (UIntN 256))) (Tagged "a2" (Identity String))) 113 | ) 114 | ( Tagged "b" 115 | (Tuple2 (Tagged "b1" (Identity (Array String))) (Tagged "b2" (Identity (BytesN 32)))) 116 | ) 117 | ) 118 | ) 119 | ) 120 | 121 | nestedTupleBytes :: HexString 122 | nestedTupleBytes = 123 | unsafePartial 124 | $ fromJust 125 | $ mkHexString "000000000000000000000000000000000000000000000000000000000000006000000000000000000000000000000000000000000000000000000000000000e0000000000000000000000000000000000000000000000000000000000000038000000000000000000000000000000000000000000000000000badab5ed11c7ca0000000000000000000000000000000000000000000000000000000000000040000000000000000000000000000000000000000000000000000000000000000fe0a183e6bc96e0b098e9ba96e4a3b5000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000406d0eb6eb8c2f86ddc21333dd73ea2ed919be82ebd61aee27be6beefce602f7c5000000000000000000000000000000000000000000000000000000000000000600000000000000000000000000000000000000000000000000000000000000c000000000000000000000000000000000000000000000000000000000000001000000000000000000000000000000000000000000000000000000000000000140000000000000000000000000000000000000000000000000000000000000018000000000000000000000000000000000000000000000000000000000000001c00000000000000000000000000000000000000000000000000000000000000200000000000000000000000000000000000000000000000000000000000000001aeebd9601eba6ace3af98e79297e98183eaa7acf394a5b6e285bf000000000000000000000000000000000000000000000000000000000000000000000000001fe691a0e993baefaabae194b8e7a0a5eb80b6e580b2e8898af0aab68eefbc8700000000000000000000000000000000000000000000000000000000000000000ce4b896e7ae94e79c98e8908900000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000003e5928000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000009e59390e89b86e991ad00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000012e5aba1eaa0bde7b090e6a4b3ef849ce1a68a000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000000000000000000000000000000000000000000000000000000000000020000000000000000000000000000000000000000000000000000000000000004000000000000000000000000000000000000000000000000000000000000000c000000000000000000000000000000000000000000000000000badab5ed11c7ca0000000000000000000000000000000000000000000000000000000000000040000000000000000000000000000000000000000000000000000000000000000fe0a183e6bc96e0b098e9ba96e4a3b5000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000406d0eb6eb8c2f86ddc21333dd73ea2ed919be82ebd61aee27be6beefce602f7c5000000000000000000000000000000000000000000000000000000000000000600000000000000000000000000000000000000000000000000000000000000c000000000000000000000000000000000000000000000000000000000000001000000000000000000000000000000000000000000000000000000000000000140000000000000000000000000000000000000000000000000000000000000018000000000000000000000000000000000000000000000000000000000000001c00000000000000000000000000000000000000000000000000000000000000200000000000000000000000000000000000000000000000000000000000000001aeebd9601eba6ace3af98e79297e98183eaa7acf394a5b6e285bf000000000000000000000000000000000000000000000000000000000000000000000000001fe691a0e993baefaabae194b8e7a0a5eb80b6e580b2e8898af0aab68eefbc8700000000000000000000000000000000000000000000000000000000000000000ce4b896e7ae94e79c98e8908900000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000003e5928000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000009e59390e89b86e991ad00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000012e5aba1eaa0bde7b090e6a4b3ef849ce1a68a0000000000000000000000000000" 126 | -------------------------------------------------------------------------------- /src/Network/Ethereum/Web3/Api.purs: -------------------------------------------------------------------------------- 1 | module Network.Ethereum.Web3.Api where 2 | 3 | import Data.Maybe (Maybe, fromMaybe) 4 | import Network.Ethereum.Types (Address, HexString, BigNumber) 5 | import Network.Ethereum.Web3.JsonRPC (remote) 6 | import Network.Ethereum.Web3.Types (Block, BlockNumber, ChainCursor, Change, FalseOrObject, Filter, FilterId, SyncStatus, Transaction, TransactionOptions, TransactionReceipt, Web3) 7 | import Network.Ethereum.Web3.Types.TokenUnit (MinorUnit) 8 | import Simple.JSON (class WriteForeign) 9 | 10 | -- | Returns current node version string. 11 | web3_clientVersion :: Partial => Web3 String 12 | web3_clientVersion = remote "web3_clientVersion" 13 | 14 | -- | Returns Keccak-256 (*not* the standardized SHA3-256) of the given data. 15 | web3_sha3 :: Partial => HexString -> Web3 HexString 16 | web3_sha3 hexInput = remote "web3_sha3" hexInput 17 | 18 | -- | Get the network id that the node is listening to. 19 | net_version :: Web3 String 20 | net_version = remote "net_version" 21 | 22 | -- | Returns `true`` if client is actively listening for network connections 23 | net_listening :: Web3 Boolean 24 | net_listening = remote "net_listening" 25 | 26 | -- | Get the number of currently connected peers. 27 | net_getPeerCount :: Web3 BigNumber 28 | net_getPeerCount = remote "net_peerCount" 29 | 30 | -- | Returns the current ethereum protocol version 31 | eth_protocolVersion :: Web3 String 32 | eth_protocolVersion = remote "eth_protocolVersion" 33 | 34 | -- | Get the sync status of the node. 35 | eth_getSyncing :: Web3 (FalseOrObject SyncStatus) 36 | eth_getSyncing = remote "eth_syncing" 37 | 38 | -- | Returns the client coinbase address 39 | eth_coinbase :: Web3 Address 40 | eth_coinbase = remote "eth_coinbase" 41 | 42 | -- | Returns `true` if client is actively mining new blocks 43 | eth_mining :: Web3 Boolean 44 | eth_mining = remote "eth_mining" 45 | 46 | -- | Returns the number of hashes per second that the node is mining with 47 | eth_hashrate :: Web3 BigNumber 48 | eth_hashrate = remote "eth_hashrate" 49 | 50 | -- | Returns the current price per gas in wei 51 | eth_gasPrice :: Web3 BigNumber 52 | eth_gasPrice = remote "eth_gasPrice" 53 | 54 | -- | Returns the number of most recent block 55 | eth_blockNumber :: Web3 BlockNumber 56 | eth_blockNumber = remote "eth_blockNumber" 57 | 58 | -- | Returns the balance of the account of given address. 59 | eth_getBalance :: Address -> ChainCursor -> Web3 BigNumber 60 | eth_getBalance addr cm = remote "eth_getBalance" addr cm 61 | 62 | -- | Returns the value from a storage position at a given address 63 | eth_getStorageAt :: Address -> BigNumber -> ChainCursor -> Web3 HexString 64 | eth_getStorageAt addr storagePos cm = remote "eth_getStorageAt" addr storagePos cm 65 | 66 | -- | Returns the number of transactions *sent* from an address 67 | eth_getTransactionCount :: Address -> ChainCursor -> Web3 BigNumber 68 | eth_getTransactionCount addr cm = remote "eth_getTransactionCount" addr cm 69 | 70 | -- | Returns the number of transactions in a block from a block matching the given block hash 71 | eth_getBlockTransactionCountByHash :: HexString -> Web3 BigNumber 72 | eth_getBlockTransactionCountByHash blockHash = remote "eth_getBlockTransactionCountByHash" blockHash 73 | 74 | -- | Returns the number of transactions in a block matching the given block number 75 | eth_getBlockTransactionCountByNumber :: ChainCursor -> Web3 BigNumber 76 | eth_getBlockTransactionCountByNumber cm = remote "eth_getBlockTransactionCountByNumber" cm 77 | 78 | -- | Returns the number of uncles in a block from a block matching the given block hash 79 | eth_getUncleCountByBlockHash :: HexString -> Web3 BigNumber 80 | eth_getUncleCountByBlockHash blockNumber = remote "eth_getUncleCountByBlockHash" blockNumber 81 | 82 | -- | Returns the number of uncles in a block from a block matching the given block number 83 | eth_getUncleCountByBlockNumber :: ChainCursor -> Web3 BigNumber 84 | eth_getUncleCountByBlockNumber cm = remote "eth_getUncleCountByBlockNumber" cm 85 | 86 | -- | Returns code at a given address 87 | eth_getCode :: Address -> ChainCursor -> Web3 HexString 88 | eth_getCode addr cm = remote "eth_getCode" addr cm 89 | 90 | -- | Creates new message call transaction or a contract creation for signed transactions 91 | eth_sendRawTransaction :: HexString -> Web3 HexString 92 | eth_sendRawTransaction rawTx = remote "eth_sendRawTransaction" rawTx 93 | 94 | -- | Makes a call or transaction, which won't be added to the blockchain and returns the used gas, which can be used for estimating the used gas. 95 | eth_estimateGas :: TransactionOptions MinorUnit -> Web3 BigNumber 96 | eth_estimateGas txOpts = remote "eth_estimateGas" txOpts 97 | 98 | -- | Returns information about a transaction by block hash and transaction index position. 99 | eth_getTransactionByBlockHashAndIndex :: HexString -> BigNumber -> Web3 Transaction 100 | eth_getTransactionByBlockHashAndIndex blockHash txIndex = remote "eth_getTransactionByBlockHashAndIndex" blockHash txIndex 101 | 102 | -- | Returns information about a transaction by block number and transaction index position. 103 | eth_getTransactionByBlockNumberAndIndex :: ChainCursor -> BigNumber -> Web3 Transaction 104 | eth_getTransactionByBlockNumberAndIndex cm txIndex = remote "eth_getTransactionByBlockNumberAndIndex" cm txIndex 105 | 106 | -- | Returns the receipt of a transaction by transaction hash. 107 | eth_getTransactionReceipt :: HexString -> Web3 TransactionReceipt 108 | eth_getTransactionReceipt txHash = remote "eth_getTransactionReceipt" txHash 109 | 110 | -- | Returns information about a uncle of a block by hash and uncle index position. 111 | eth_getUncleByBlockHashAndIndex :: HexString -> BigNumber -> Web3 Block 112 | eth_getUncleByBlockHashAndIndex blockHash uncleIndex = remote "eth_getUncleByBlockHashAndIndex" blockHash uncleIndex 113 | 114 | -- | Returns information about a uncle of a block by number and uncle index position. 115 | eth_getUncleByBlockNumberAndIndex :: ChainCursor -> BigNumber -> Web3 Block 116 | eth_getUncleByBlockNumberAndIndex cm uncleIndex = remote "eth_getUncleByBlockNumberAndIndex" cm uncleIndex 117 | 118 | -- | Returns a list of available compilers in the client. 119 | eth_getCompilers :: Partial => Web3 (Array String) 120 | eth_getCompilers = remote "eth_getCompilers" 121 | 122 | -- | Returns information about a block by number. 123 | eth_getBlockByNumber :: ChainCursor -> Web3 Block 124 | eth_getBlockByNumber cm = remote "eth_getBlockByNumber" cm false 125 | 126 | -- | Returns information about a block by hash. 127 | eth_getBlockByHash :: HexString -> Web3 Block 128 | eth_getBlockByHash hx = remote "eth_getBlockByHash" hx false 129 | 130 | -- | Returns information about a transaction by hash. 131 | eth_getTransaction :: HexString -> Web3 Transaction 132 | eth_getTransaction hx = remote "eth_getTransactionByHash" hx 133 | 134 | -- | Call a function on a particular block's state root. 135 | eth_call :: forall a. WriteForeign (TransactionOptions a) => TransactionOptions a -> ChainCursor -> Web3 HexString 136 | eth_call opts cm = remote "eth_call" opts cm 137 | 138 | -- | Creates new message call transaction or a contract creation, if the data field contains code. 139 | eth_sendTransaction :: TransactionOptions MinorUnit -> Web3 HexString 140 | eth_sendTransaction opts = remote "eth_sendTransaction" opts 141 | 142 | -- | Get all account addresses registered at the `Provider` 143 | eth_getAccounts :: Web3 (Array Address) 144 | eth_getAccounts = remote "eth_accounts" 145 | 146 | -- | Creates a filter object, based on filter options, to notify when the 147 | -- | state changes (logs). To check if the state has changed, call 'eth_getFilterChanges'. 148 | eth_newFilter :: forall a. Filter a -> Web3 FilterId 149 | eth_newFilter f = remote "eth_newFilter" f 150 | 151 | -- | Creates a filter in the node, to notify when a new block arrives. 152 | -- | To check if the state has changed, call `eth_getFilterChanges`. 153 | eth_newBlockFilter :: Web3 FilterId 154 | eth_newBlockFilter = remote "eth_newBlockFilter" 155 | 156 | -- | Polling method for a filter, which returns an array of logs which occurred since last poll. 157 | eth_getFilterChanges :: FilterId -> Web3 (Array Change) 158 | eth_getFilterChanges fid = remote "eth_getFilterChanges" fid 159 | 160 | -- | Returns an array of all logs matching filter with given id. 161 | eth_getFilterLogs :: FilterId -> Web3 (Array Change) 162 | eth_getFilterLogs fid = remote "eth_getFilterLogs" fid 163 | 164 | -- | Returns an array of all logs matching a given filter object 165 | eth_getLogs :: forall a. Filter a -> Web3 (Array Change) 166 | eth_getLogs filter = remote "eth_getLogs" filter 167 | 168 | -- | Uninstalls a filter with given id. Should always be called when watch is no longer needed. 169 | eth_uninstallFilter :: FilterId -> Web3 Boolean 170 | eth_uninstallFilter fid = remote "eth_uninstallFilter" fid 171 | 172 | -- | Sign a message with the given address, returning the signature. 173 | personal_sign :: HexString -> Address -> Maybe String -> Web3 HexString 174 | personal_sign _data signer password = remote "personal_sign" _data signer (fromMaybe "" password) 175 | 176 | -- | Recover the address that signed the message from (1) the message and (2) the signature 177 | personal_ecRecover :: HexString -> HexString -> Web3 Address 178 | personal_ecRecover _data sig = remote "personal_ecRecover" _data sig 179 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Apache License 2 | Version 2.0, January 2004 3 | http://www.apache.org/licenses/ 4 | 5 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 6 | 7 | 1. Definitions. 8 | 9 | "License" shall mean the terms and conditions for use, reproduction, 10 | and distribution as defined by Sections 1 through 9 of this document. 11 | 12 | "Licensor" shall mean the copyright owner or entity authorized by 13 | the copyright owner that is granting the License. 14 | 15 | "Legal Entity" shall mean the union of the acting entity and all 16 | other entities that control, are controlled by, or are under common 17 | control with that entity. For the purposes of this definition, 18 | "control" means (i) the power, direct or indirect, to cause the 19 | direction or management of such entity, whether by contract or 20 | otherwise, or (ii) ownership of fifty percent (50%) or more of the 21 | outstanding shares, or (iii) beneficial ownership of such entity. 22 | 23 | "You" (or "Your") shall mean an individual or Legal Entity 24 | exercising permissions granted by this License. 25 | 26 | "Source" form shall mean the preferred form for making modifications, 27 | including but not limited to software source code, documentation 28 | source, and configuration files. 29 | 30 | "Object" form shall mean any form resulting from mechanical 31 | transformation or translation of a Source form, including but 32 | not limited to compiled object code, generated documentation, 33 | and conversions to other media types. 34 | 35 | "Work" shall mean the work of authorship, whether in Source or 36 | Object form, made available under the License, as indicated by a 37 | copyright notice that is included in or attached to the work 38 | (an example is provided in the Appendix below). 39 | 40 | "Derivative Works" shall mean any work, whether in Source or Object 41 | form, that is based on (or derived from) the Work and for which the 42 | editorial revisions, annotations, elaborations, or other modifications 43 | represent, as a whole, an original work of authorship. For the purposes 44 | of this License, Derivative Works shall not include works that remain 45 | separable from, or merely link (or bind by name) to the interfaces of, 46 | the Work and Derivative Works thereof. 47 | 48 | "Contribution" shall mean any work of authorship, including 49 | the original version of the Work and any modifications or additions 50 | to that Work or Derivative Works thereof, that is intentionally 51 | submitted to Licensor for inclusion in the Work by the copyright owner 52 | or by an individual or Legal Entity authorized to submit on behalf of 53 | the copyright owner. For the purposes of this definition, "submitted" 54 | means any form of electronic, verbal, or written communication sent 55 | to the Licensor or its representatives, including but not limited to 56 | communication on electronic mailing lists, source code control systems, 57 | and issue tracking systems that are managed by, or on behalf of, the 58 | Licensor for the purpose of discussing and improving the Work, but 59 | excluding communication that is conspicuously marked or otherwise 60 | designated in writing by the copyright owner as "Not a Contribution." 61 | 62 | "Contributor" shall mean Licensor and any individual or Legal Entity 63 | on behalf of whom a Contribution has been received by Licensor and 64 | subsequently incorporated within the Work. 65 | 66 | 2. Grant of Copyright License. Subject to the terms and conditions of 67 | this License, each Contributor hereby grants to You a perpetual, 68 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 69 | copyright license to reproduce, prepare Derivative Works of, 70 | publicly display, publicly perform, sublicense, and distribute the 71 | Work and such Derivative Works in Source or Object form. 72 | 73 | 3. Grant of Patent License. Subject to the terms and conditions of 74 | this License, each Contributor hereby grants to You a perpetual, 75 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 76 | (except as stated in this section) patent license to make, have made, 77 | use, offer to sell, sell, import, and otherwise transfer the Work, 78 | where such license applies only to those patent claims licensable 79 | by such Contributor that are necessarily infringed by their 80 | Contribution(s) alone or by combination of their Contribution(s) 81 | with the Work to which such Contribution(s) was submitted. If You 82 | institute patent litigation against any entity (including a 83 | cross-claim or counterclaim in a lawsuit) alleging that the Work 84 | or a Contribution incorporated within the Work constitutes direct 85 | or contributory patent infringement, then any patent licenses 86 | granted to You under this License for that Work shall terminate 87 | as of the date such litigation is filed. 88 | 89 | 4. Redistribution. You may reproduce and distribute copies of the 90 | Work or Derivative Works thereof in any medium, with or without 91 | modifications, and in Source or Object form, provided that You 92 | meet the following conditions: 93 | 94 | (a) You must give any other recipients of the Work or 95 | Derivative Works a copy of this License; and 96 | 97 | (b) You must cause any modified files to carry prominent notices 98 | stating that You changed the files; and 99 | 100 | (c) You must retain, in the Source form of any Derivative Works 101 | that You distribute, all copyright, patent, trademark, and 102 | attribution notices from the Source form of the Work, 103 | excluding those notices that do not pertain to any part of 104 | the Derivative Works; and 105 | 106 | (d) If the Work includes a "NOTICE" text file as part of its 107 | distribution, then any Derivative Works that You distribute must 108 | include a readable copy of the attribution notices contained 109 | within such NOTICE file, excluding those notices that do not 110 | pertain to any part of the Derivative Works, in at least one 111 | of the following places: within a NOTICE text file distributed 112 | as part of the Derivative Works; within the Source form or 113 | documentation, if provided along with the Derivative Works; or, 114 | within a display generated by the Derivative Works, if and 115 | wherever such third-party notices normally appear. The contents 116 | of the NOTICE file are for informational purposes only and 117 | do not modify the License. You may add Your own attribution 118 | notices within Derivative Works that You distribute, alongside 119 | or as an addendum to the NOTICE text from the Work, provided 120 | that such additional attribution notices cannot be construed 121 | as modifying the License. 122 | 123 | You may add Your own copyright statement to Your modifications and 124 | may provide additional or different license terms and conditions 125 | for use, reproduction, or distribution of Your modifications, or 126 | for any such Derivative Works as a whole, provided Your use, 127 | reproduction, and distribution of the Work otherwise complies with 128 | the conditions stated in this License. 129 | 130 | 5. Submission of Contributions. Unless You explicitly state otherwise, 131 | any Contribution intentionally submitted for inclusion in the Work 132 | by You to the Licensor shall be under the terms and conditions of 133 | this License, without any additional terms or conditions. 134 | Notwithstanding the above, nothing herein shall supersede or modify 135 | the terms of any separate license agreement you may have executed 136 | with Licensor regarding such Contributions. 137 | 138 | 6. Trademarks. This License does not grant permission to use the trade 139 | names, trademarks, service marks, or product names of the Licensor, 140 | except as required for reasonable and customary use in describing the 141 | origin of the Work and reproducing the content of the NOTICE file. 142 | 143 | 7. Disclaimer of Warranty. Unless required by applicable law or 144 | agreed to in writing, Licensor provides the Work (and each 145 | Contributor provides its Contributions) on an "AS IS" BASIS, 146 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or 147 | implied, including, without limitation, any warranties or conditions 148 | of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A 149 | PARTICULAR PURPOSE. You are solely responsible for determining the 150 | appropriateness of using or redistributing the Work and assume any 151 | risks associated with Your exercise of permissions under this License. 152 | 153 | 8. Limitation of Liability. In no event and under no legal theory, 154 | whether in tort (including negligence), contract, or otherwise, 155 | unless required by applicable law (such as deliberate and grossly 156 | negligent acts) or agreed to in writing, shall any Contributor be 157 | liable to You for damages, including any direct, indirect, special, 158 | incidental, or consequential damages of any character arising as a 159 | result of this License or out of the use or inability to use the 160 | Work (including but not limited to damages for loss of goodwill, 161 | work stoppage, computer failure or malfunction, or any and all 162 | other commercial damages or losses), even if such Contributor 163 | has been advised of the possibility of such damages. 164 | 165 | 9. Accepting Warranty or Additional Liability. While redistributing 166 | the Work or Derivative Works thereof, You may choose to offer, 167 | and charge a fee for, acceptance of support, warranty, indemnity, 168 | or other liability obligations and/or rights consistent with this 169 | License. However, in accepting such obligations, You may act only 170 | on Your own behalf and on Your sole responsibility, not on behalf 171 | of any other Contributor, and only if You agree to indemnify, 172 | defend, and hold each Contributor harmless for any liability 173 | incurred by, or claims asserted against, such Contributor by reason 174 | of your accepting any such warranty or additional liability. 175 | 176 | END OF TERMS AND CONDITIONS 177 | 178 | APPENDIX: How to apply the Apache License to your work. 179 | 180 | To apply the Apache License to your work, attach the following 181 | boilerplate notice, with the fields enclosed by brackets "{}" 182 | replaced with your own identifying information. (Don't include 183 | the brackets!) The text should be enclosed in the appropriate 184 | comment syntax for the file format. We also recommend that a 185 | file or class name and description of purpose be included on the 186 | same "printed page" as the copyright notice for easier 187 | identification within third-party archives. 188 | 189 | Copyright {yyyy} {name of copyright owner} 190 | 191 | Licensed under the Apache License, Version 2.0 (the "License"); 192 | you may not use this file except in compliance with the License. 193 | You may obtain a copy of the License at 194 | 195 | http://www.apache.org/licenses/LICENSE-2.0 196 | 197 | Unless required by applicable law or agreed to in writing, software 198 | distributed under the License is distributed on an "AS IS" BASIS, 199 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 200 | See the License for the specific language governing permissions and 201 | limitations under the License. 202 | -------------------------------------------------------------------------------- /src/Network/Ethereum/Web3/Solidity/Tuple.purs: -------------------------------------------------------------------------------- 1 | module Network.Ethereum.Web3.Solidity.Tuple 2 | ( Tuple0(..) 3 | , Tuple10(..) 4 | , Tuple11(..) 5 | , Tuple12(..) 6 | , Tuple13(..) 7 | , Tuple14(..) 8 | , Tuple15(..) 9 | , Tuple16(..) 10 | , Tuple1(..) 11 | , Tuple2(..) 12 | , Tuple3(..) 13 | , Tuple4(..) 14 | , Tuple5(..) 15 | , Tuple6(..) 16 | , Tuple7(..) 17 | , Tuple8(..) 18 | , Tuple9(..) 19 | , curry1 20 | , curry10 21 | , curry11 22 | , curry12 23 | , curry13 24 | , curry14 25 | , curry15 26 | , curry16 27 | , curry2 28 | , curry3 29 | , curry4 30 | , curry5 31 | , curry6 32 | , curry7 33 | , curry8 34 | , curry9 35 | , unTuple1 36 | , uncurry1 37 | , uncurry10 38 | , uncurry11 39 | , uncurry12 40 | , uncurry13 41 | , uncurry14 42 | , uncurry15 43 | , uncurry16 44 | , uncurry2 45 | , uncurry3 46 | , uncurry4 47 | , uncurry5 48 | , uncurry6 49 | , uncurry7 50 | , uncurry8 51 | , uncurry9 52 | ) where 53 | 54 | import Prelude 55 | 56 | import Data.Generic.Rep (class Generic) 57 | import Data.Show.Generic (genericShow) 58 | 59 | -- * Tuple0 60 | data Tuple0 = Tuple0 61 | 62 | derive instance Generic Tuple0 _ 63 | 64 | instance Show Tuple0 where 65 | show _ = "Tuple0" 66 | 67 | derive instance Eq Tuple0 68 | 69 | -- * Tuple 1 70 | newtype Tuple1 a = Tuple1 a 71 | 72 | derive instance Generic (Tuple1 a) _ 73 | 74 | instance Show a => Show (Tuple1 a) where 75 | show = genericShow 76 | 77 | derive instance Eq a => Eq (Tuple1 a) 78 | 79 | unTuple1 :: forall a. Tuple1 a -> a 80 | unTuple1 (Tuple1 a) = a 81 | 82 | uncurry1 :: forall a b. (a -> b) -> Tuple1 a -> b 83 | uncurry1 fun (Tuple1 a) = fun a 84 | 85 | curry1 :: forall a b. (Tuple1 a -> b) -> a -> b 86 | curry1 fun a = fun (Tuple1 a) 87 | 88 | -- * Tuple2 89 | data Tuple2 a b = Tuple2 a b 90 | 91 | derive instance Generic (Tuple2 a b) _ 92 | 93 | instance (Show a, Show b) => Show (Tuple2 a b) where 94 | show = genericShow 95 | 96 | derive instance (Eq a, Eq b) => Eq (Tuple2 a b) 97 | 98 | uncurry2 :: forall a b c. (a -> b -> c) -> Tuple2 a b -> c 99 | uncurry2 fun (Tuple2 a b) = fun a b 100 | 101 | curry2 :: forall a b c. (Tuple2 a b -> c) -> a -> b -> c 102 | curry2 fun a b = fun (Tuple2 a b) 103 | 104 | -- * Tuple3 105 | data Tuple3 a b c = Tuple3 a b c 106 | 107 | derive instance Generic (Tuple3 a b c) _ 108 | 109 | instance (Show a, Show b, Show c) => Show (Tuple3 a b c) where 110 | show = genericShow 111 | 112 | derive instance (Eq a, Eq b, Eq c) => Eq (Tuple3 a b c) 113 | 114 | uncurry3 :: forall a b c d. (a -> b -> c -> d) -> Tuple3 a b c -> d 115 | uncurry3 fun (Tuple3 a b c) = fun a b c 116 | 117 | curry3 :: forall a b c d. (Tuple3 a b c -> d) -> a -> b -> c -> d 118 | curry3 fun a b c = fun (Tuple3 a b c) 119 | 120 | -- * Tuple4 121 | data Tuple4 a b c d = Tuple4 a b c d 122 | 123 | derive instance Generic (Tuple4 a b c d) _ 124 | 125 | instance (Show a, Show b, Show c, Show d) => Show (Tuple4 a b c d) where 126 | show = genericShow 127 | 128 | derive instance (Eq a, Eq b, Eq c, Eq d) => Eq (Tuple4 a b c d) 129 | 130 | uncurry4 :: forall a b c d e. (a -> b -> c -> d -> e) -> Tuple4 a b c d -> e 131 | uncurry4 fun (Tuple4 a b c d) = fun a b c d 132 | 133 | curry4 :: forall a b c d e. (Tuple4 a b c d -> e) -> a -> b -> c -> d -> e 134 | curry4 fun a b c d = fun (Tuple4 a b c d) 135 | 136 | -- * Tuple5 137 | data Tuple5 a b c d e = Tuple5 a b c d e 138 | 139 | derive instance Generic (Tuple5 a b c d e) _ 140 | 141 | instance (Show a, Show b, Show c, Show d, Show e) => Show (Tuple5 a b c d e) where 142 | show = genericShow 143 | 144 | derive instance (Eq a, Eq b, Eq c, Eq d, Eq e) => Eq (Tuple5 a b c d e) 145 | 146 | uncurry5 :: forall a b c d e f. (a -> b -> c -> d -> e -> f) -> Tuple5 a b c d e -> f 147 | uncurry5 fun (Tuple5 a b c d e) = fun a b c d e 148 | 149 | curry5 :: forall a b c d e f. (Tuple5 a b c d e -> f) -> a -> b -> c -> d -> e -> f 150 | curry5 fun a b c d e = fun (Tuple5 a b c d e) 151 | 152 | -- * Tuple6 153 | data Tuple6 a b c d e f = Tuple6 a b c d e f 154 | 155 | derive instance Generic (Tuple6 a b c d e f) _ 156 | 157 | instance (Show a, Show b, Show c, Show d, Show e, Show f) => Show (Tuple6 a b c d e f) where 158 | show = genericShow 159 | 160 | derive instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f) => Eq (Tuple6 a b c d e f) 161 | 162 | uncurry6 :: forall a b c d e f g. (a -> b -> c -> d -> e -> f -> g) -> Tuple6 a b c d e f -> g 163 | uncurry6 fun (Tuple6 a b c d e f) = fun a b c d e f 164 | 165 | curry6 :: forall a b c d e f g. (Tuple6 a b c d e f -> g) -> a -> b -> c -> d -> e -> f -> g 166 | curry6 fun a b c d e f = fun (Tuple6 a b c d e f) 167 | 168 | -- * Tuple7 169 | data Tuple7 a b c d e f g = Tuple7 a b c d e f g 170 | 171 | derive instance Generic (Tuple7 a b c d e f g) _ 172 | 173 | instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g) => Show (Tuple7 a b c d e f g) where 174 | show = genericShow 175 | 176 | derive instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g) => Eq (Tuple7 a b c d e f g) 177 | 178 | uncurry7 :: forall a b c d e f g h. (a -> b -> c -> d -> e -> f -> g -> h) -> Tuple7 a b c d e f g -> h 179 | uncurry7 fun (Tuple7 a b c d e f g) = fun a b c d e f g 180 | 181 | curry7 :: forall a b c d e f g h. (Tuple7 a b c d e f g -> h) -> a -> b -> c -> d -> e -> f -> g -> h 182 | curry7 fun a b c d e f g = fun (Tuple7 a b c d e f g) 183 | 184 | -- * Tuple8 185 | data Tuple8 a b c d e f g h = Tuple8 a b c d e f g h 186 | 187 | derive instance Generic (Tuple8 a b c d e f g h) _ 188 | 189 | derive instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, Eq h) => Eq (Tuple8 a b c d e f g h) 190 | 191 | instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h) => Show (Tuple8 a b c d e f g h) where 192 | show = genericShow 193 | 194 | uncurry8 :: forall a b c d e f g h i. (a -> b -> c -> d -> e -> f -> g -> h -> i) -> Tuple8 a b c d e f g h -> i 195 | uncurry8 fun (Tuple8 a b c d e f g h) = fun a b c d e f g h 196 | 197 | curry8 :: forall a b c d e f g h i. (Tuple8 a b c d e f g h -> i) -> a -> b -> c -> d -> e -> f -> g -> h -> i 198 | curry8 fun a b c d e f g h = fun (Tuple8 a b c d e f g h) 199 | 200 | -- * Tuple9 201 | data Tuple9 a b c d e f g h i = Tuple9 a b c d e f g h i 202 | 203 | derive instance Generic (Tuple9 a b c d e f g h i) _ 204 | 205 | instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i) => Show (Tuple9 a b c d e f g h i) where 206 | show = genericShow 207 | 208 | derive instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, Eq h, Eq i) => Eq (Tuple9 a b c d e f g h i) 209 | 210 | uncurry9 :: forall a b c d e f g h i j. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j) -> Tuple9 a b c d e f g h i -> j 211 | uncurry9 fun (Tuple9 a b c d e f g h i) = fun a b c d e f g h i 212 | 213 | curry9 :: forall a b c d e f g h i j. (Tuple9 a b c d e f g h i -> j) -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j 214 | curry9 fun a b c d e f g h i = fun (Tuple9 a b c d e f g h i) 215 | 216 | -- * Tuple10 217 | data Tuple10 a b c d e f g h i j = Tuple10 a b c d e f g h i j 218 | 219 | derive instance Generic (Tuple10 a b c d e f g h i j) _ 220 | 221 | instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j) => Show (Tuple10 a b c d e f g h i j) where 222 | show = genericShow 223 | 224 | derive instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, Eq h, Eq i, Eq j) => Eq (Tuple10 a b c d e f g h i j) 225 | 226 | uncurry10 :: forall a b c d e f g h i j k. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k) -> Tuple10 a b c d e f g h i j -> k 227 | uncurry10 fun (Tuple10 a b c d e f g h i j) = fun a b c d e f g h i j 228 | 229 | curry10 :: forall a b c d e f g h i j k. (Tuple10 a b c d e f g h i j -> k) -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k 230 | curry10 fun a b c d e f g h i j = fun (Tuple10 a b c d e f g h i j) 231 | 232 | -- * Tuple11 233 | data Tuple11 a b c d e f g h i j k = Tuple11 a b c d e f g h i j k 234 | 235 | derive instance Generic (Tuple11 a b c d e f g h i j k) _ 236 | 237 | instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k) => Show (Tuple11 a b c d e f g h i j k) where 238 | show = genericShow 239 | 240 | derive instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, Eq h, Eq i, Eq j, Eq k) => Eq (Tuple11 a b c d e f g h i j k) 241 | 242 | uncurry11 :: forall a b c d e f g h i j k l. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l) -> Tuple11 a b c d e f g h i j k -> l 243 | uncurry11 fun (Tuple11 a b c d e f g h i j k) = fun a b c d e f g h i j k 244 | 245 | curry11 :: forall a b c d e f g h i j k l. (Tuple11 a b c d e f g h i j k -> l) -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l 246 | curry11 fun a b c d e f g h i j k = fun (Tuple11 a b c d e f g h i j k) 247 | 248 | -- * Tuple12 249 | data Tuple12 a b c d e f g h i j k l = Tuple12 a b c d e f g h i j k l 250 | 251 | derive instance Generic (Tuple12 a b c d e f g h i j k l) _ 252 | 253 | instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k, Show l) => Show (Tuple12 a b c d e f g h i j k l) where 254 | show = genericShow 255 | 256 | derive instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, Eq h, Eq i, Eq j, Eq k, Eq l) => Eq (Tuple12 a b c d e f g h i j k l) 257 | 258 | uncurry12 :: forall a b c d e f g h i j k l m. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m) -> Tuple12 a b c d e f g h i j k l -> m 259 | uncurry12 fun (Tuple12 a b c d e f g h i j k l) = fun a b c d e f g h i j k l 260 | 261 | curry12 :: forall a b c d e f g h i j k l m. (Tuple12 a b c d e f g h i j k l -> m) -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m 262 | curry12 fun a b c d e f g h i j k l = fun (Tuple12 a b c d e f g h i j k l) 263 | 264 | -- * Tuple13 265 | data Tuple13 a b c d e f g h i j k l m = Tuple13 a b c d e f g h i j k l m 266 | 267 | derive instance genericTuple13 :: Generic (Tuple13 a b c d e f g h i j k l m) _ 268 | 269 | instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k, Show l, Show m) => Show (Tuple13 a b c d e f g h i j k l m) where 270 | show = genericShow 271 | 272 | derive instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, Eq h, Eq i, Eq j, Eq k, Eq l, Eq m) => Eq (Tuple13 a b c d e f g h i j k l m) 273 | 274 | uncurry13 :: forall a b c d e f g h i j k l m n. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m -> n) -> Tuple13 a b c d e f g h i j k l m -> n 275 | uncurry13 fun (Tuple13 a b c d e f g h i j k l m) = fun a b c d e f g h i j k l m 276 | 277 | curry13 :: forall a b c d e f g h i j k l m n. (Tuple13 a b c d e f g h i j k l m -> n) -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m -> n 278 | curry13 fun a b c d e f g h i j k l m = fun (Tuple13 a b c d e f g h i j k l m) 279 | 280 | -- * Tuple14 281 | data Tuple14 a b c d e f g h i j k l m n = Tuple14 a b c d e f g h i j k l m n 282 | 283 | derive instance Generic (Tuple14 a b c d e f g h i j k l m n) _ 284 | 285 | instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k, Show l, Show m, Show n) => Show (Tuple14 a b c d e f g h i j k l m n) where 286 | show = genericShow 287 | 288 | derive instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, Eq h, Eq i, Eq j, Eq k, Eq l, Eq m, Eq n) => Eq (Tuple14 a b c d e f g h i j k l m n) 289 | 290 | uncurry14 :: forall a b c d e f g h i j k l m n o. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m -> n -> o) -> Tuple14 a b c d e f g h i j k l m n -> o 291 | uncurry14 fun (Tuple14 a b c d e f g h i j k l m n) = fun a b c d e f g h i j k l m n 292 | 293 | curry14 :: forall a b c d e f g h i j k l m n o. (Tuple14 a b c d e f g h i j k l m n -> o) -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m -> n -> o 294 | curry14 fun a b c d e f g h i j k l m n = fun (Tuple14 a b c d e f g h i j k l m n) 295 | 296 | -- * Tuple15 297 | data Tuple15 a b c d e f g h i j k l m n o = Tuple15 a b c d e f g h i j k l m n o 298 | 299 | derive instance genericTuple15 :: Generic (Tuple15 a b c d e f g h i j k l m n o) _ 300 | 301 | instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k, Show l, Show m, Show n, Show o) => Show (Tuple15 a b c d e f g h i j k l m n o) where 302 | show = genericShow 303 | 304 | derive instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, Eq h, Eq i, Eq j, Eq k, Eq l, Eq m, Eq n, Eq o) => Eq (Tuple15 a b c d e f g h i j k l m n o) 305 | 306 | uncurry15 :: forall a b c d e f g h i j k l m n o p. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m -> n -> o -> p) -> Tuple15 a b c d e f g h i j k l m n o -> p 307 | uncurry15 fun (Tuple15 a b c d e f g h i j k l m n o) = fun a b c d e f g h i j k l m n o 308 | 309 | curry15 :: forall a b c d e f g h i j k l m n o p. (Tuple15 a b c d e f g h i j k l m n o -> p) -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m -> n -> o -> p 310 | curry15 fun a b c d e f g h i j k l m n o = fun (Tuple15 a b c d e f g h i j k l m n o) 311 | 312 | -- * Tuple16 313 | data Tuple16 a b c d e f g h i j k l m n o p = Tuple16 a b c d e f g h i j k l m n o p 314 | 315 | derive instance Generic (Tuple16 a b c d e f g h i j k l m n o p) _ 316 | 317 | instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k, Show l, Show m, Show n, Show o, Show p) => Show (Tuple16 a b c d e f g h i j k l m n o p) where 318 | show = genericShow 319 | 320 | derive instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, Eq h, Eq i, Eq j, Eq k, Eq l, Eq m, Eq n, Eq o, Eq p) => Eq (Tuple16 a b c d e f g h i j k l m n o p) 321 | 322 | uncurry16 :: forall a b c d e f g h i j k l m n o p q. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m -> n -> o -> p -> q) -> Tuple16 a b c d e f g h i j k l m n o p -> q 323 | uncurry16 fun (Tuple16 a b c d e f g h i j k l m n o p) = fun a b c d e f g h i j k l m n o p 324 | 325 | curry16 :: forall a b c d e f g h i j k l m n o p q. (Tuple16 a b c d e f g h i j k l m n o p -> q) -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m -> n -> o -> p -> q 326 | curry16 fun a b c d e f g h i j k l m n o p = fun (Tuple16 a b c d e f g h i j k l m n o p) 327 | -------------------------------------------------------------------------------- /src/Network/Ethereum/Web3/Solidity/AbiEncoding.purs: -------------------------------------------------------------------------------- 1 | module Network.Ethereum.Web3.Solidity.AbiEncoding 2 | ( class ABIDecode 3 | , abiDecode 4 | , _abiDecode 5 | , class ABIEncode 6 | , abiEncode 7 | , class EncodingType 8 | , isDynamic 9 | , class GEncodingType 10 | , gIsDynamic 11 | , class GenericABIDecode 12 | , gABIDecode 13 | , class GenericABIEncode 14 | , gAbiEncode 15 | ) where 16 | 17 | import Prelude 18 | 19 | import Node.Encoding (Encoding(UTF8)) 20 | import Data.Array (foldMap, foldl, length, sortBy, (:)) 21 | import Node.Buffer.Immutable (ImmutableBuffer) 22 | import Node.Buffer.Immutable as B 23 | import Data.Either (Either) 24 | import Data.Functor.Tagged (Tagged, tagged, untagged) 25 | import Data.Generic.Rep (class Generic, Argument(..), Constructor(..), NoArguments(..), Product(..), from, repOf, to) 26 | import Data.Identity (Identity(..)) 27 | import Data.Maybe (Maybe(..), maybe) 28 | import Data.Monoid.Endo (Endo(..)) 29 | import Data.Newtype (un) 30 | import Data.Reflectable (class Reflectable, reflectType) 31 | import Data.Symbol (class IsSymbol) 32 | import Data.Traversable (foldMapDefaultR) 33 | import Data.Tuple (Tuple(..)) 34 | import Data.Unfoldable (replicateA) 35 | import Network.Ethereum.Core.BigNumber (fromString, fromTwosComplement, toString, toTwosComplement, unsafeToInt) 36 | import Network.Ethereum.Core.HexString (HexString, PadByte(..), fromBuffer, mkHexString, numberOfBytes, padLeft, padRight, splitAtByteOffset, toBuffer, unHex) 37 | import Network.Ethereum.Types (Address, BigNumber, fromInt, mkAddress, unAddress) 38 | import Network.Ethereum.Web3.Solidity.Bytes (BytesN, unBytesN, update, proxyBytesN) 39 | import Network.Ethereum.Web3.Solidity.Int (IntN, unIntN, intNFromBigNumber) 40 | import Network.Ethereum.Web3.Solidity.UInt (UIntN, unUIntN, uIntNFromBigNumber) 41 | import Network.Ethereum.Web3.Solidity.Vector (Vector, unVector) 42 | import Parsing (ParseError, ParseState(..), Parser, ParserT, Position(..), fail, getParserT, runParser, stateParserT) 43 | import Parsing.Combinators (lookAhead) 44 | import Partial.Unsafe (unsafeCrashWith) 45 | import Type.Proxy (Proxy(..)) 46 | 47 | class EncodingType :: forall k. k -> Constraint 48 | class EncodingType a where 49 | isDynamic :: Proxy a -> Boolean 50 | 51 | instance EncodingType Boolean where 52 | isDynamic = const false 53 | else instance EncodingType Int where 54 | isDynamic = const false 55 | else instance EncodingType BigNumber where 56 | isDynamic = const false 57 | else instance EncodingType (UIntN n) where 58 | isDynamic = const false 59 | else instance EncodingType (IntN n) where 60 | isDynamic = const false 61 | else instance EncodingType String where 62 | isDynamic = const true 63 | else instance EncodingType Address where 64 | isDynamic = const false 65 | else instance EncodingType a => EncodingType (Array a) where 66 | isDynamic = const true 67 | else instance EncodingType (BytesN n) where 68 | isDynamic = const false 69 | else instance EncodingType a => EncodingType (Vector n a) where 70 | isDynamic _ = isDynamic (Proxy :: Proxy a) 71 | else instance EncodingType ImmutableBuffer where 72 | isDynamic = const true 73 | else instance EncodingType a => EncodingType (Tagged s a) where 74 | isDynamic _ = isDynamic (Proxy :: Proxy a) 75 | else instance EncodingType a => EncodingType (Identity a) where 76 | isDynamic _ = isDynamic (Proxy :: Proxy a) 77 | else instance (Generic a rep, GEncodingType rep) => EncodingType a where 78 | isDynamic p = gIsDynamic (repOf p) 79 | 80 | class GEncodingType :: forall k. k -> Constraint 81 | class GEncodingType rep where 82 | gIsDynamic :: Proxy rep -> Boolean 83 | 84 | instance GEncodingType NoArguments where 85 | gIsDynamic _ = false 86 | else instance EncodingType a => GEncodingType (Argument a) where 87 | gIsDynamic _ = isDynamic (Proxy @a) 88 | else instance (GEncodingType a, GEncodingType b) => GEncodingType (Product a b) where 89 | gIsDynamic _ = gIsDynamic (Proxy @a) || gIsDynamic (Proxy @b) 90 | else instance GEncodingType a => GEncodingType (Constructor s a) where 91 | gIsDynamic _ = gIsDynamic (Proxy @a) 92 | 93 | -- | Class representing values that have an encoding and decoding instance to/from a solidity type. 94 | class EncodingType a <= ABIEncode a where 95 | abiEncode :: a -> HexString 96 | 97 | instance ABIEncode BigNumber where 98 | abiEncode = int256HexBuilder 99 | 100 | else instance ABIEncode Boolean where 101 | abiEncode b = uInt256HexBuilder $ if b then one else zero 102 | 103 | else instance ABIEncode Int where 104 | abiEncode = int256HexBuilder <<< fromInt 105 | 106 | else instance Reflectable n Int => ABIEncode (UIntN n) where 107 | abiEncode a = uInt256HexBuilder <<< unUIntN $ a 108 | 109 | else instance ABIEncode Address where 110 | abiEncode addr = padLeft Zero <<< unAddress $ addr 111 | 112 | else instance Reflectable n Int => ABIEncode (BytesN n) where 113 | abiEncode bs = bytesBuilder <<< unBytesN $ bs 114 | 115 | else instance Reflectable n Int => ABIEncode (IntN n) where 116 | abiEncode a = int256HexBuilder <<< unIntN $ a 117 | 118 | else instance ABIEncode ImmutableBuffer where 119 | abiEncode bytes = uInt256HexBuilder (fromInt $ B.size bytes) <> bytesBuilder bytes 120 | 121 | else instance ABIEncode String where 122 | abiEncode = abiEncode <<< \a -> B.fromString a UTF8 123 | 124 | else instance ABIEncode a => ABIEncode (Array a) where 125 | abiEncode l = 126 | uInt256HexBuilder (fromInt $ length l) <> 127 | (combineEncodedValues $ un Endo (foldMapDefaultR factorBuilder l) []) 128 | 129 | else instance (ABIEncode a, Reflectable n Int) => ABIEncode (Vector n a) where 130 | abiEncode l = 131 | combineEncodedValues $ un Endo (foldMapDefaultR factorBuilder $ unVector l) [] 132 | 133 | else instance ABIEncode a => ABIEncode (Identity a) where 134 | abiEncode = abiEncode <<< un Identity 135 | 136 | else instance ABIEncode a => ABIEncode (Tagged s a) where 137 | abiEncode = abiEncode <<< untagged 138 | 139 | else instance (Generic a rep, EncodingType a, GenericABIEncode rep) => ABIEncode a where 140 | abiEncode a = combineEncodedValues $ un Endo (gAbiEncode $ from a) [] 141 | 142 | type EncodedValue = 143 | { order :: Int 144 | , isDynamic :: Boolean 145 | , encoding :: HexString 146 | , encodingLengthInBytes :: Int -- cache 147 | } 148 | 149 | type ABIDataBuilder = Endo (->) (Array EncodedValue) 150 | 151 | -- | An internally used class for encoding 152 | class GenericABIEncode rep where 153 | gAbiEncode :: rep -> ABIDataBuilder 154 | 155 | combineEncodedValues :: Array EncodedValue -> HexString 156 | combineEncodedValues = 157 | sortBy (\_a _b -> _a.order `compare` _b.order) 158 | >>> \encodings -> 159 | let 160 | wordLengthInBytes = 32 161 | 162 | headsOffsetInBytes :: Int 163 | headsOffsetInBytes = 164 | let 165 | f = \encodedValueSimple -> 166 | if encodedValueSimple.isDynamic then wordLengthInBytes 167 | else encodedValueSimple.encodingLengthInBytes 168 | in 169 | foldl (+) 0 $ map f encodings 170 | 171 | (heads :: HexString) = 172 | foldl 173 | ( \{ accumulator, lengthOfPreviousDynamicValues } encodedValue -> 174 | if encodedValue.isDynamic then 175 | { accumulator: accumulator <> uInt256HexBuilder (fromInt $ headsOffsetInBytes + lengthOfPreviousDynamicValues) 176 | , lengthOfPreviousDynamicValues: lengthOfPreviousDynamicValues + encodedValue.encodingLengthInBytes 177 | } 178 | else 179 | { accumulator: accumulator <> encodedValue.encoding 180 | , lengthOfPreviousDynamicValues: lengthOfPreviousDynamicValues 181 | } 182 | ) 183 | { accumulator: mempty 184 | , lengthOfPreviousDynamicValues: 0 185 | } 186 | encodings 187 | # _.accumulator 188 | 189 | (tails :: HexString) = 190 | foldMap 191 | ( \encodedValue -> 192 | if encodedValue.isDynamic then 193 | encodedValue.encoding 194 | else 195 | mempty 196 | ) 197 | encodings 198 | in 199 | heads <> tails 200 | 201 | instance GenericABIEncode NoArguments where 202 | gAbiEncode _ = mempty 203 | 204 | else instance GenericABIEncode b => GenericABIEncode (Constructor s b) where 205 | gAbiEncode (Constructor b) = gAbiEncode b 206 | 207 | else instance ABIEncode b => GenericABIEncode (Argument b) where 208 | gAbiEncode (Argument b) = factorBuilder b 209 | 210 | else instance (GenericABIEncode a, GenericABIEncode b) => GenericABIEncode (Product a b) where 211 | gAbiEncode (Product a b) = gAbiEncode a <> gAbiEncode b 212 | 213 | factorBuilder :: forall a. ABIEncode a => a -> ABIDataBuilder 214 | factorBuilder a = Endo \encoded -> 215 | let 216 | encoding = abiEncode a 217 | in 218 | { encoding 219 | , order: 1 220 | , isDynamic: isDynamic (Proxy :: Proxy a) 221 | , encodingLengthInBytes: numberOfBytes encoding 222 | } : map (\x -> x { order = x.order + 1 }) encoded 223 | 224 | -- | base16 encode, then utf8 encode, then pad 225 | bytesBuilder :: ImmutableBuffer -> HexString 226 | bytesBuilder = padRight Zero <<< fromBuffer 227 | 228 | -- | Encode something that is essentaially a signed integer. 229 | int256HexBuilder :: BigNumber -> HexString 230 | int256HexBuilder x = 231 | let 232 | x' = case mkHexString $ toString $ toTwosComplement 256 x of 233 | Nothing -> unsafeCrashWith $ "Failed to encode as hex string: " <> show x 234 | Just a -> a 235 | in 236 | if x < zero then padLeft FF x' 237 | else padLeft Zero x' 238 | 239 | -- | Encode something that is essentially an unsigned integer. 240 | uInt256HexBuilder :: BigNumber -> HexString 241 | uInt256HexBuilder x = 242 | case padLeft Zero <$> mkHexString (toString x) of 243 | Nothing -> unsafeCrashWith $ "Failed to encode as hex string: " <> show x 244 | Just a -> a 245 | 246 | -------------------------------------------------------------------------------- 247 | 248 | abiDecode :: forall a. ABIDecode a => HexString -> Either ParseError a 249 | abiDecode = flip runParser _abiDecode 250 | 251 | class EncodingType a <= ABIDecode a where 252 | _abiDecode :: Parser HexString a 253 | 254 | instance ABIDecode BigNumber where 255 | _abiDecode = int256HexParser 256 | 257 | else instance ABIDecode Boolean where 258 | _abiDecode = toBool <$> uInt256HexParser 259 | where 260 | toBool bn = not $ bn == zero 261 | 262 | else instance ABIDecode Int where 263 | _abiDecode = unsafeToInt <$> int256HexParser 264 | 265 | else instance ABIDecode Address where 266 | _abiDecode = do 267 | _ <- parseBytes 12 268 | maddr <- mkAddress <$> parseBytes 20 269 | maybe (fail "Address is 20 bytes, receieved more") pure maddr 270 | 271 | else instance ABIDecode ImmutableBuffer where 272 | _abiDecode = do 273 | len <- _abiDecode 274 | toBuffer <$> parseBytes len 275 | 276 | else instance ABIDecode String where 277 | _abiDecode = B.toString UTF8 <$> _abiDecode 278 | 279 | else instance Reflectable n Int => ABIDecode (BytesN n) where 280 | _abiDecode = do 281 | let 282 | len = reflectType (Proxy :: Proxy n) 283 | zeroBytes = 32 - len 284 | raw <- parseBytes len 285 | _ <- parseBytes zeroBytes 286 | pure <<< update proxyBytesN <<< toBuffer $ raw 287 | 288 | else instance (Reflectable n Int, ABIDecode a) => ABIDecode (Vector n a) where 289 | _abiDecode = 290 | let 291 | len = reflectType (Proxy :: Proxy n) 292 | in 293 | replicateA len factorParser 294 | 295 | else instance ABIDecode a => ABIDecode (Array a) where 296 | _abiDecode = do 297 | len <- _abiDecode 298 | resetOffset 299 | replicateA len factorParser 300 | 301 | else instance Reflectable n Int => ABIDecode (UIntN n) where 302 | _abiDecode = do 303 | a <- uInt256HexParser 304 | maybe (fail $ msg a) pure <<< uIntNFromBigNumber (Proxy @n) $ a 305 | where 306 | msg n = 307 | let 308 | size = reflectType (Proxy @n) 309 | in 310 | "Couldn't parse as uint" <> show size <> " : " <> show n 311 | 312 | else instance Reflectable n Int => ABIDecode (IntN n) where 313 | _abiDecode = do 314 | a <- int256HexParser 315 | maybe (fail $ msg a) pure <<< intNFromBigNumber (Proxy :: Proxy n) $ a 316 | where 317 | msg n = 318 | let 319 | size = reflectType (Proxy :: Proxy n) 320 | in 321 | "Couldn't parse as int" <> show size <> " : " <> show n 322 | 323 | else instance ABIDecode a => ABIDecode (Tagged s a) where 324 | _abiDecode = tagged <$> _abiDecode 325 | 326 | else instance ABIDecode a => ABIDecode (Identity a) where 327 | _abiDecode = Identity <$> _abiDecode 328 | 329 | else instance (Generic a rep, EncodingType a, GenericABIDecode rep) => ABIDecode a where 330 | _abiDecode = to <$> gABIDecode 331 | 332 | class GenericABIDecode a where 333 | gABIDecode :: Parser HexString a 334 | 335 | instance GenericABIDecode NoArguments where 336 | gABIDecode = pure NoArguments 337 | 338 | else instance ABIDecode a => GenericABIDecode (Argument a) where 339 | gABIDecode = Argument <$> factorParser 340 | 341 | else instance (IsSymbol name, GenericABIDecode a) => GenericABIDecode (Constructor name a) where 342 | gABIDecode = Constructor <$> gABIDecode 343 | 344 | else instance (GenericABIDecode b, GenericABIDecode a) => GenericABIDecode (Product a b) where 345 | gABIDecode = Product <$> gABIDecode <*> gABIDecode 346 | 347 | factorParser :: forall a. ABIDecode a => Parser HexString a 348 | factorParser 349 | | isDynamic (Proxy :: Proxy a) = do 350 | dataOffset <- _abiDecode 351 | found <- lookAhead 352 | $ do 353 | (ParseState _ (Position { index }) _) <- getParserT 354 | void $ parseBytes (dataOffset - index) 355 | resetOffset 356 | _abiDecode 357 | pure found 358 | | otherwise = _abiDecode 359 | 360 | -- | Parse as a signed `BigNumber` 361 | int256HexParser :: forall m. Monad m => ParserT HexString m BigNumber 362 | int256HexParser = do 363 | bs <- unHex <$> parseBytes 32 364 | a <- maybe (fail $ "Failed to parse bytes as BigNumber " <> bs) pure (fromString bs) 365 | pure $ fromTwosComplement 256 a 366 | 367 | -- | Parse an unsigned `BigNumber` 368 | uInt256HexParser :: forall m. Monad m => ParserT HexString m BigNumber 369 | uInt256HexParser = do 370 | bs <- unHex <$> parseBytes 32 371 | maybe (fail $ "Failed to parse bytes as BigNumber " <> bs) pure (fromString bs) 372 | 373 | -- | Read any number of HexDigits 374 | parseBytes :: forall m. Monad m => Int -> ParserT HexString m HexString 375 | parseBytes n 376 | | n < 0 = fail "Cannot parse negative bytes" 377 | | n == 0 = pure mempty 378 | | otherwise = do 379 | ParseState input (Position position) _ <- getParserT 380 | when (numberOfBytes input < n) $ fail "Unexpected EOF" 381 | let 382 | { after, before } = splitAtByteOffset n input 383 | position' = Position $ position { index = position.index + n } 384 | newState = ParseState after position' true 385 | stateParserT $ const (Tuple before newState) 386 | 387 | resetOffset :: forall m. Monad m => ParserT HexString m Unit 388 | resetOffset = stateParserT \(ParseState s (Position p) c) -> 389 | Tuple unit (ParseState s (Position p { index = 0 }) c) 390 | -------------------------------------------------------------------------------- /test/web3/Web3Spec/Encoding/ContainersSpec.purs: -------------------------------------------------------------------------------- 1 | module Web3Spec.Encoding.ContainersSpec (spec, BMPString(..)) where 2 | 3 | import Prelude 4 | 5 | import Control.Monad.Gen (chooseInt, frequency, oneOf, suchThat) 6 | import Data.Array (filter, foldMap, take, (..)) 7 | import Data.Array.NonEmpty (NonEmptyArray, fromArray) 8 | import Data.Array.NonEmpty as NEA 9 | import Data.Either (Either(..)) 10 | import Data.Enum (toEnumWithDefaults) 11 | import Data.Foldable (for_) 12 | import Data.Int (toNumber) 13 | import Data.Maybe (Maybe(..)) 14 | import Data.Newtype (class Newtype, un) 15 | import Data.NonEmpty (NonEmpty(..)) 16 | import Data.Reflectable (reifyType) 17 | import Data.String (CodePoint, fromCodePointArray) 18 | import Data.Tuple (Tuple(..)) 19 | import Effect.Class (liftEffect) 20 | import Effect.Class.Console as Console 21 | import Network.Ethereum.Core.HexString as Hex 22 | import Network.Ethereum.Core.Signatures as Address 23 | import Network.Ethereum.Web3.Solidity (class ABIDecode, class ABIEncode, class EncodingType, Tuple2(..), Tuple3(..), Tuple4(..), Tuple5(..), abiDecode, abiEncode) 24 | import Network.Ethereum.Web3.Solidity.Bytes as BytesN 25 | import Network.Ethereum.Web3.Solidity.Int as IntN 26 | import Network.Ethereum.Web3.Solidity.UInt as UIntN 27 | import Network.Ethereum.Web3.Solidity.Vector as Vector 28 | import Parsing (ParseError) 29 | import Partial.Unsafe (unsafeCrashWith) 30 | import Test.QuickCheck (class Arbitrary, arbitrary, quickCheck, quickCheckGen, quickCheckGen', (===)) 31 | import Test.QuickCheck.Gen (Gen, arrayOf) 32 | import Test.Spec (Spec, describe, it) 33 | 34 | spec :: Spec Unit 35 | spec = 36 | describe "encoding-spec for containers" do 37 | typePropertyTests 38 | arrayTypePropertyTests 39 | vecTypePropertyTests 40 | nestedTypePropertyTests 41 | tupleTests 42 | 43 | typePropertyTests :: Spec Unit 44 | typePropertyTests = 45 | describe "Type property tests" do 46 | it "can encode/decode a string" $ liftEffect $ do 47 | Console.log "wtf" 48 | quickCheck \(x :: BMPString) -> 49 | let 50 | y = un BMPString x 51 | in 52 | (encodeDecode y) === Right y 53 | 54 | it "can encode/decode bytestring" $ liftEffect $ do 55 | quickCheckGen $ do 56 | n <- chooseInt 1 100 57 | x <- Hex.toBuffer <$> Hex.generator n 58 | pure $ encodeDecode x === Right x 59 | 60 | it "can encode/decode bool" $ liftEffect $ do 61 | quickCheck \(x :: Boolean) -> encodeDecode x === Right x 62 | 63 | it "can encode/decode address" $ liftEffect $ do 64 | quickCheckGen $ do 65 | x <- Address.generator 66 | pure $ encodeDecode x === Right x 67 | 68 | it "can encode/decode intN" $ liftEffect $ do 69 | for_ intSizes $ \n -> quickCheckGen $ do 70 | reifyType n \p -> do 71 | x <- IntN.generator p 72 | pure $ encodeDecode x === Right x 73 | 74 | it "can encode/decode uintN" $ liftEffect $ do 75 | for_ intSizes $ \n -> quickCheckGen $ do 76 | reifyType n \p -> do 77 | x <- UIntN.generator p 78 | pure $ encodeDecode x === Right x 79 | 80 | it "can encode/decode bytesN" $ liftEffect $ do 81 | for_ bytesSizes $ \n -> quickCheckGen $ do 82 | reifyType n \p -> do 83 | x <- BytesN.generator p 84 | pure $ encodeDecode x === Right x 85 | 86 | it "can encode/decode string" $ liftEffect $ do 87 | quickCheck \(x :: BMPString) -> 88 | let 89 | y = un BMPString x 90 | in 91 | encodeDecode y === Right y 92 | 93 | arrayTypePropertyTests :: Spec Unit 94 | arrayTypePropertyTests = do 95 | 96 | describe "Array type property tests" do 97 | 98 | it "Can encode/decode intN[]" $ liftEffect do 99 | for_ intSizes $ \n -> quickCheckGen $ do 100 | reifyType n \p -> do 101 | x <- arrayOf (IntN.generator p) 102 | pure $ encodeDecode x === Right x 103 | 104 | it "Can encode/decode uintN[]" $ liftEffect do 105 | for_ intSizes $ \n -> quickCheckGen $ do 106 | reifyType n \p -> do 107 | x <- arrayOf (UIntN.generator p) 108 | pure $ encodeDecode x === Right x 109 | 110 | it "Can encode/decode bytesN[]" $ liftEffect do 111 | for_ bytesSizes $ \n -> quickCheckGen $ do 112 | reifyType n \p -> do 113 | x <- arrayOf (BytesN.generator p) 114 | pure $ encodeDecode x === Right x 115 | 116 | it "Can encode/decode address[]" $ liftEffect do 117 | quickCheckGen $ do 118 | x <- Address.generator 119 | pure $ encodeDecode x === Right x 120 | 121 | it "Can encode/decode string[]" $ liftEffect do 122 | quickCheck $ \(x :: Array BMPString) -> 123 | let 124 | y = map (un BMPString) x 125 | in 126 | encodeDecode y === Right y 127 | 128 | vecTypePropertyTests :: Spec Unit 129 | vecTypePropertyTests = do 130 | 131 | describe "Vector type property tests" do 132 | 133 | it "Can encode/decode intN[k]" $ liftEffect do 134 | for_ intSizes $ \n -> 135 | quickCheckGen $ do 136 | k <- chooseInt 1 10 137 | reifyType k \pk -> 138 | reifyType n \pn -> do 139 | x <- Vector.generator pk (IntN.generator pn) 140 | pure $ encodeDecode x === Right x 141 | 142 | it "Can encode/decode uintN[k]" $ liftEffect do 143 | for_ intSizes $ \n -> 144 | quickCheckGen $ do 145 | k <- chooseInt 1 10 146 | reifyType k \pk -> 147 | reifyType n \pn -> do 148 | x <- Vector.generator pk (UIntN.generator pn) 149 | pure $ encodeDecode x === Right x 150 | 151 | it "Can encode/decode bytesN[k]" $ liftEffect do 152 | for_ bytesSizes $ \n -> 153 | quickCheckGen $ do 154 | k <- chooseInt 1 10 155 | reifyType k \pk -> 156 | reifyType n \pn -> do 157 | x <- Vector.generator pk (BytesN.generator pn) 158 | pure $ encodeDecode x === Right x 159 | 160 | it "Can encode/decode address[k]" $ liftEffect do 161 | quickCheckGen $ do 162 | k <- chooseInt 1 10 163 | reifyType k \pk -> do 164 | x <- Vector.generator pk Address.generator 165 | pure $ encodeDecode x === Right x 166 | 167 | it "Can encode/decode string[k]" $ liftEffect do 168 | quickCheckGen $ do 169 | k <- chooseInt 1 10 170 | reifyType k \pk -> do 171 | _x <- Vector.generator pk (arbitrary :: Gen BMPString) 172 | let x = un BMPString <$> _x 173 | pure $ encodeDecode x === Right x 174 | 175 | nestedTypePropertyTests :: Spec Unit 176 | nestedTypePropertyTests = do 177 | describe "Nested type property tests for vector, vector" do 178 | 179 | it "Can encode/decode bytesN[k1][k2]" $ liftEffect do 180 | for_ bytesSizes $ \n -> do 181 | quickCheckGen $ do 182 | k1 <- chooseInt 1 10 183 | k2 <- chooseInt 1 10 184 | reifyType k1 \pk1 -> 185 | reifyType k2 \pk2 -> 186 | reifyType n \pn -> do 187 | x <- Vector.generator pk2 (Vector.generator pk1 (BytesN.generator pn)) 188 | pure $ encodeDecode x === Right x 189 | 190 | it "Can encode/decode string[k1][k2]" $ liftEffect do 191 | quickCheckGen $ do 192 | k1 <- chooseInt 1 10 193 | k2 <- chooseInt 1 10 194 | reifyType k1 \pk1 -> 195 | reifyType k2 \pk2 -> do 196 | _x <- Vector.generator pk2 (Vector.generator pk1 (arbitrary :: Gen BMPString)) 197 | let x = map (un BMPString) <$> _x 198 | pure $ encodeDecode x === Right x 199 | 200 | describe "Nested type property tests for array, vector" do 201 | 202 | it "Can encode/decode bytesN[k][]" $ liftEffect do 203 | for_ bytesSizes $ \n -> do 204 | quickCheckGen $ do 205 | k <- chooseInt 1 10 206 | reifyType k \pk -> 207 | reifyType n \pn -> do 208 | x <- arrayOf (Vector.generator pk (BytesN.generator pn)) 209 | pure $ encodeDecode x === Right x 210 | 211 | it "Can encode/decode string[k][]" $ liftEffect do 212 | quickCheckGen $ do 213 | k <- chooseInt 1 10 214 | reifyType k \pk -> do 215 | _x <- arrayOf (Vector.generator pk (arbitrary :: Gen BMPString)) 216 | let x = map (un BMPString) <$> _x 217 | pure $ encodeDecode x === Right x 218 | 219 | describe "Nested type property tests for vector, array" do 220 | 221 | it "Can encode/decode uintN[][k]" $ liftEffect do 222 | for_ intSizes $ \n -> do 223 | quickCheckGen $ do 224 | k <- chooseInt 1 10 225 | reifyType k \pk -> 226 | reifyType n \pn -> do 227 | x <- (Vector.generator pk (arrayOf $ UIntN.generator pn)) 228 | pure $ encodeDecode x === Right x 229 | 230 | it "Can encode/decode string[][k]" $ liftEffect do 231 | quickCheckGen $ do 232 | k <- chooseInt 1 10 233 | reifyType k \pk -> do 234 | _x <- (Vector.generator pk (arrayOf (arbitrary :: Gen BMPString))) 235 | let x = map (un BMPString) <$> _x 236 | pure $ encodeDecode x === Right x 237 | 238 | describe "Nested type property tests for array, array" do 239 | 240 | it "Can encode/decode intN[][]" $ liftEffect do 241 | for_ intSizes $ \n -> do 242 | quickCheckGen $ 243 | reifyType n \pn -> do 244 | x <- (arrayOf (arrayOf $ IntN.generator pn)) 245 | pure $ encodeDecode x === Right x 246 | 247 | it "Can encode/decode string[][]" $ liftEffect do 248 | quickCheck \(x :: Array (Array BMPString)) -> 249 | let 250 | y = map (map (un BMPString)) x 251 | in 252 | encodeDecode y === Right y 253 | 254 | tupleTests :: Spec Unit 255 | tupleTests = do 256 | 257 | describe "Basic static sized Tuple Tests" $ do 258 | 259 | it "Can encode/decode (intN, address, bool, uintN, bytesN)" $ liftEffect do 260 | quickCheckGen $ do 261 | n <- oneOf (pure <$> intSizes) 262 | m <- oneOf (pure <$> intSizes) 263 | k <- oneOf (pure <$> bytesSizes) 264 | reifyType n \pn -> 265 | reifyType m \pm -> 266 | reifyType k \pk -> do 267 | int <- IntN.generator pn 268 | addr <- Address.generator 269 | bool <- arbitrary :: Gen Boolean 270 | uint <- UIntN.generator pm 271 | bytes <- BytesN.generator pk 272 | let x = Tuple5 int addr bool uint bytes 273 | pure $ encodeDecode x === Right x 274 | 275 | it "Can encode/decode (address[k], bool, intN[k], uint)" $ liftEffect do 276 | quickCheckGen' 1 $ do 277 | k1 <- chooseInt 1 10 278 | k2 <- chooseInt 1 10 279 | n <- oneOf (pure <$> intSizes) 280 | m <- oneOf (pure <$> intSizes) 281 | reifyType k1 \pk1 -> 282 | reifyType k2 \pk2 -> 283 | reifyType n \pn -> do 284 | reifyType m \pm -> do 285 | addrs <- arrayOf (Vector.generator pk1 Address.generator) 286 | bool <- arbitrary @Boolean 287 | ints <- Vector.generator pk2 (IntN.generator pn) 288 | uint <- (UIntN.generator pm) 289 | let x = Tuple4 addrs bool ints uint 290 | pure $ encodeDecode x === Right x 291 | 292 | describe "Basic dynamic sized Tuple Tests" $ do 293 | 294 | it "Can encode/decode (intN[], bytes, address[][k], string[k][], bool)" $ liftEffect do 295 | quickCheckGen $ do 296 | n <- oneOf (pure <$> intSizes) 297 | m <- chooseInt 1 10 298 | k <- chooseInt 1 10 299 | reifyType n \pn -> 300 | reifyType m \pm -> 301 | reifyType k \pk -> do 302 | ints <- arrayOf (IntN.generator pn) 303 | bytes <- Hex.toBuffer <$> (chooseInt 1 100 >>= Hex.generator) 304 | addrs <- Vector.generator pm (arrayOf Address.generator) 305 | strings <- arrayOf (Vector.generator pk (arbitrary @BMPString)) 306 | bool <- arbitrary :: Gen Boolean 307 | let x = Tuple5 ints bytes addrs (map (un BMPString) <$> strings) bool 308 | pure $ encodeDecode x === Right x 309 | 310 | it "Can encode/decode (address[k], bool, intN[k], uint)" $ liftEffect do 311 | quickCheckGen' 5 $ do 312 | k1 <- chooseInt 1 10 313 | k2 <- chooseInt 1 10 314 | n <- oneOf (pure <$> intSizes) 315 | m <- oneOf (pure <$> intSizes) 316 | reifyType k1 \pk1 -> 317 | reifyType k2 \pk2 -> 318 | reifyType n \pn -> do 319 | reifyType m \pm -> do 320 | addrs <- arrayOf (Vector.generator pk1 Address.generator) 321 | bool <- arbitrary @Boolean 322 | ints <- Vector.generator pk2 (IntN.generator pn) 323 | uint <- (UIntN.generator pm) 324 | let x = Tuple4 addrs bool ints uint 325 | pure $ encodeDecode x === Right x 326 | 327 | it "Can encode/decode arrays of tuples" $ liftEffect do 328 | quickCheckGen' 5 $ do 329 | k1 <- chooseInt 1 3 330 | reifyType k1 \pk1 -> 331 | do 332 | let 333 | tupleGen = do 334 | addrs <- arrayOf (Vector.generator pk1 Address.generator) 335 | bool <- arbitrary @Boolean 336 | pure $ Tuple2 addrs bool 337 | as <- take 2 <$> arrayOf tupleGen 338 | pure $ encodeDecode as === Right as 339 | 340 | -- this test is admittedly pretty ad hoc 341 | it "Can encode/decode nested tuples" $ liftEffect do 342 | quickCheckGen' 5 do 343 | k1 <- chooseInt 1 10 344 | k2 <- chooseInt 1 10 345 | n <- oneOf (pure <$> intSizes) 346 | m <- oneOf (pure <$> intSizes) 347 | reifyType k1 \pk1 -> 348 | reifyType k2 \pk2 -> 349 | reifyType n \pn -> 350 | reifyType m \pm -> do 351 | let 352 | mkTuple4 = do 353 | addrs <- arrayOf (Vector.generator pk1 Address.generator) 354 | bool <- arbitrary @Boolean 355 | ints <- Vector.generator pk2 (IntN.generator pn) 356 | uint <- (UIntN.generator pm) 357 | pure $ Tuple4 addrs bool ints uint 358 | _n <- oneOf (pure <$> intSizes) 359 | _m <- chooseInt 1 10 360 | _k <- chooseInt 1 10 361 | reifyType _n \_pn -> 362 | reifyType _m \_pm -> 363 | reifyType _k \_pk -> do 364 | let 365 | mkTuple5 = do 366 | ints <- arrayOf (IntN.generator _pn) 367 | bytes <- Hex.toBuffer <$> (chooseInt 1 100 >>= Hex.generator) 368 | addrs <- Vector.generator _pm (arrayOf Address.generator) 369 | strings <- map (map (un BMPString)) <$> 370 | arrayOf (Vector.generator _pk (arbitrary @BMPString)) 371 | bool <- arbitrary :: Gen Boolean 372 | pure $ Tuple5 ints bytes addrs strings bool 373 | mkTuple2 = do 374 | strings <- map (un BMPString) <$> 375 | arrayOf (arbitrary @BMPString) 376 | addrs <- Vector.generator pk2 (arrayOf Address.generator) 377 | pure $ Tuple2 strings addrs 378 | 379 | t <- Tuple3 <$> mkTuple5 <*> mkTuple4 <*> mkTuple2 380 | pure $ encodeDecode t === Right t 381 | 382 | -------------------------------------------------------------------------------- 383 | newtype BMPString = BMPString String 384 | 385 | derive newtype instance Eq BMPString 386 | derive newtype instance Show BMPString 387 | 388 | derive instance Newtype BMPString _ 389 | 390 | data UnicodeChar = Normal CodePoint | Surrogates CodePoint CodePoint 391 | 392 | instance Arbitrary BMPString where 393 | arbitrary = BMPString <$> do 394 | ucs <- arrayOf arbitrary 395 | pure $ fromCodePointArray $ foldMap f ucs 396 | where 397 | f uc = case uc of 398 | Normal a -> [ a ] 399 | Surrogates a b -> [ a, b ] 400 | 401 | instance Arbitrary UnicodeChar where 402 | arbitrary = frequency $ NonEmpty (Tuple (1.0 - p) normalGen) [ Tuple p surrogatesGen ] 403 | 404 | where 405 | hiLB = 0xD800 406 | hiUB = 0xDBFF 407 | loLB = 0xDC00 408 | loUB = 0xDFFF 409 | maxCP = 65535 410 | toCP = toEnumWithDefaults bottom top 411 | -- must have a high surrogate followed by a low surrogate 412 | surrogatesGen = Surrogates <$> (toCP <$> chooseInt hiLB hiUB) <*> (toCP <$> chooseInt loLB loUB) 413 | normalGen = Normal <<< toCP <$> do 414 | chooseInt 0 maxCP `suchThat` \n -> 415 | (n < hiLB || n > hiUB) && (n < loLB || n > loUB) 416 | -- probability that you pick a surrogate from all possible codepoints 417 | p = toNumber ((hiUB - hiLB + 1) + (loUB - loLB + 1)) / toNumber (maxCP + 1) 418 | 419 | encodeDecode 420 | :: forall a 421 | . Show a 422 | => Eq a 423 | => EncodingType a 424 | => ABIEncode a 425 | => ABIDecode a 426 | => a 427 | -> Either ParseError a 428 | encodeDecode x = 429 | let 430 | a = abiEncode x 431 | in 432 | abiDecode a 433 | 434 | intSizes :: NonEmptyArray Int 435 | intSizes = case fromArray $ filter (\x -> x `mod` 8 == 0) (8 .. 256) of 436 | Nothing -> unsafeCrashWith "intSizes: impossible" 437 | Just x -> x 438 | 439 | bytesSizes :: NonEmptyArray Int 440 | bytesSizes = 1 NEA... 32 441 | -------------------------------------------------------------------------------- /src/Network/Ethereum/Web3/Contract/Events.purs: -------------------------------------------------------------------------------- 1 | module Network.Ethereum.Web3.Contract.Events 2 | ( event' 3 | , pollEvent' 4 | , reduceEventStream 5 | , aquireFilter 6 | , pollFilter 7 | , logsStream 8 | , EventHandler 9 | , FilterStreamState 10 | , ChangeReceipt 11 | , FilterChange(..) 12 | , MultiFilterMinToBlock 13 | , MultiFilterMinFromBlock 14 | , ModifyFilter 15 | , QueryAllLogs 16 | , MultiFilterStreamState(..) 17 | , OpenMultiFilter 18 | , CloseMultiFilter 19 | , CheckMultiFilter 20 | ) where 21 | 22 | import Prelude 23 | 24 | import Control.Coroutine (Process, Consumer, producer, consumer, pullFrom, runProcess) 25 | import Control.Coroutine.Transducer (Transducer, awaitForever, fromProducer, toProducer, yieldT, (=>=)) 26 | import Control.Monad.Fork.Class (bracket) 27 | import Control.Monad.Reader.Trans (ReaderT, runReaderT) 28 | import Control.Monad.Rec.Class (class MonadRec) 29 | import Control.Monad.Trans.Class (lift) 30 | import Control.Parallel (class Parallel) 31 | import Data.Array (sort) 32 | import Data.Either (Either(..)) 33 | import Data.Functor.Tagged (Tagged, tagged, untagged) 34 | import Data.Lens ((.~), (^.)) 35 | import Data.Maybe (Maybe(..), maybe) 36 | import Data.Newtype (over) 37 | import Data.Symbol (class IsSymbol) 38 | import Data.Traversable (for_, traverse) 39 | import Data.Tuple (Tuple(..), fst) 40 | import Data.Variant (Variant, class VariantMatchCases, expand, inj, match) 41 | import Effect.Aff (delay, Milliseconds(..)) 42 | import Effect.Aff.Class (liftAff) 43 | import Heterogeneous.Folding (class FoldingWithIndex, class FoldlRecord, hfoldlWithIndex) 44 | import Heterogeneous.Mapping (class MapRecordWithIndex, class Mapping, ConstMapping, hmap) 45 | import Network.Ethereum.Core.BigNumber (BigNumber, fromInt) 46 | import Network.Ethereum.Core.HexString (HexString) 47 | import Network.Ethereum.Web3.Api (eth_blockNumber, eth_getFilterChanges, eth_getLogs, eth_newFilter, eth_uninstallFilter) 48 | import Network.Ethereum.Web3.Solidity.Event (class DecodeEvent, decodeEvent) 49 | import Network.Ethereum.Web3.Types (BlockNumber(..), ChainCursor(..), Change(..), EventAction(..), Filter, FilterId, Web3, Web3Error, _fromBlock, _toBlock, throwWeb3) 50 | import Prim.RowList as RowList 51 | import Record as Record 52 | import Type.Proxy (Proxy(..)) 53 | import Type.Row as Row 54 | 55 | -------------------------------------------------------------------------------- 56 | -- * Types 57 | -------------------------------------------------------------------------------- 58 | type EventHandler f e = e -> ReaderT Change f EventAction 59 | 60 | type FilterStreamState (e :: Type) = 61 | { currentBlock :: BlockNumber 62 | , initialFilter :: Filter e 63 | , windowSize :: Int 64 | , trailBy :: Int 65 | } 66 | 67 | newtype FilterChange a = FilterChange 68 | { rawChange :: Change 69 | , event :: a 70 | } 71 | 72 | filterChangeToIndex :: forall a. FilterChange a -> Tuple BlockNumber BigNumber 73 | filterChangeToIndex (FilterChange { rawChange: Change change }) = Tuple change.blockNumber change.logIndex 74 | 75 | instance eqFilterChange :: Eq (FilterChange a) where 76 | eq f1 f2 = filterChangeToIndex f1 `eq` filterChangeToIndex f2 77 | 78 | instance ordFilterChange :: Ord (FilterChange a) where 79 | compare f1 f2 = filterChangeToIndex f1 `compare` filterChangeToIndex f2 80 | 81 | instance functorFilterChange :: Functor FilterChange where 82 | map f (FilterChange e) = FilterChange e { event = f e.event } 83 | 84 | type ChangeReceipt = 85 | { logIndex :: BigNumber 86 | , blockHash :: HexString 87 | , blockNumber :: BlockNumber 88 | , action :: EventAction 89 | } 90 | 91 | -------------------------------------------------------------------------------- 92 | -- | Takes a record of `Filter`s and a key-corresponding record of `EventHandler`s 93 | -- | to match. It also has options for trailing the chain head by a certain 94 | -- | number of blocks (where applicable), as well as a window size for requesting 95 | -- | larger intervals of blocks (where applicable). When the underlying coroutine 96 | -- | terminates, it will return either the state at the time of termination, or a 97 | -- | `ChangeReceipt` for the event that caused the termination. 98 | event' 99 | :: forall fs handlers fsList handlersList r1 r 100 | . FoldlRecord MultiFilterMinFromBlock ChainCursor fsList fs ChainCursor 101 | => FoldlRecord MultiFilterMinToBlock ChainCursor fsList fs ChainCursor 102 | => RowList.RowToList handlers handlersList 103 | => MapRecordWithIndex fsList (ConstMapping ModifyFilter) fs fs 104 | => RowList.RowToList fs fsList 105 | => VariantMatchCases handlersList r1 (ReaderT Change Web3 EventAction) 106 | => Row.Union r1 () r 107 | => FoldlRecord QueryAllLogs (Web3 (Array (FilterChange (Variant ())))) fsList fs (Web3 (Array (FilterChange (Variant r)))) 108 | => Record fs 109 | -> Record handlers 110 | -> { windowSize :: Int, trailBy :: Int } 111 | -> Web3 (Either (MultiFilterStreamState fs) ChangeReceipt) 112 | event' filters handlerR { windowSize, trailBy } = do 113 | currentBlock <- case hfoldlWithIndex MultiFilterMinFromBlock Latest filters of 114 | BN bn -> pure bn 115 | Latest -> eth_blockNumber 116 | let 117 | initialState = 118 | MultiFilterStreamState 119 | { currentBlock 120 | , filters 121 | , windowSize 122 | , trailBy 123 | } 124 | runProcess $ reduceEventStream (logsStream initialState) handlerR 125 | 126 | -- | Takes a record of filters and a key-corresponding record of handlers. 127 | -- | Establishes filters for polling on the server a la the filterIds. 128 | -- | Automatically handles cleaning up resources on the server. 129 | pollEvent' 130 | :: forall fs fsList handlers handlersList fsIds fsIdsList r r1 131 | . RowList.RowToList handlers handlersList 132 | => RowList.RowToList fs fsList 133 | => RowList.RowToList fsIds fsIdsList 134 | => MapRecordWithIndex fsList (ConstMapping ModifyFilter) fs fs 135 | => FoldlRecord MultiFilterMinFromBlock ChainCursor fsList fs ChainCursor 136 | => FoldlRecord MultiFilterMinToBlock ChainCursor fsList fs ChainCursor 137 | => VariantMatchCases handlersList r1 (ReaderT Change Web3 EventAction) 138 | => FoldlRecord OpenMultiFilter (Web3 (Record ())) fsList fs (Web3 (Record fsIds)) 139 | => FoldlRecord CloseMultiFilter (Web3 Unit) fsIdsList fsIds (Web3 Unit) 140 | => FoldlRecord CheckMultiFilter (Web3 (Array (FilterChange (Variant ())))) fsIdsList fsIds (Web3 (Array (FilterChange (Variant r)))) 141 | => Row.Union r1 () r 142 | => Record fs 143 | -> Record handlers 144 | -> Web3 (Either BlockNumber ChangeReceipt) 145 | pollEvent' filters handlers = 146 | let 147 | processor fids stop = 148 | runProcess 149 | $ reduceEventStream (stagger $ pollFilter fids stop) handlers 150 | in 151 | aquireFilter filters processor 152 | 153 | -------------------------------------------------------------------------------- 154 | -- * Event Coroutines 155 | -------------------------------------------------------------------------------- 156 | eventRunner 157 | :: forall handlers handlersList r r1 f 158 | . RowList.RowToList handlers handlersList 159 | => Monad f 160 | => VariantMatchCases handlersList r1 (ReaderT Change f EventAction) 161 | => Row.Union r1 () r 162 | => Record handlers 163 | -> Consumer (FilterChange (Variant r)) f ChangeReceipt 164 | eventRunner handlersR = 165 | consumer \change -> do 166 | receipt <- processChange handlersR change 167 | pure case receipt.action of 168 | ContinueEvent -> Nothing 169 | TerminateEvent -> Just receipt 170 | 171 | -- | Taking an initial state, create a stream of filter records used for querying event logs. 172 | -- | The coroutine terminates when it has read up to the `toBlock` field, yielding 173 | -- | the current state. 174 | filterProducer 175 | :: forall fs fsList 176 | . RowList.RowToList fs fsList 177 | => FoldlRecord MultiFilterMinToBlock ChainCursor fsList fs ChainCursor 178 | => MapRecordWithIndex fsList (ConstMapping ModifyFilter) fs fs 179 | => MultiFilterStreamState fs 180 | -> Transducer Void (Record fs) Web3 (MultiFilterStreamState fs) 181 | filterProducer cs@(MultiFilterStreamState currentState@{ windowSize, currentBlock, filters: currentFilters }) = do 182 | chainHead <- lift eth_blockNumber 183 | let 184 | { nextEndBlock, finalBlock } = case hfoldlWithIndex MultiFilterMinToBlock Latest currentFilters of 185 | Latest -> 186 | { nextEndBlock: over BlockNumber (_ - fromInt currentState.trailBy) chainHead 187 | , finalBlock: Nothing 188 | } 189 | BN targetEnd -> 190 | let 191 | nextAvailableBlock = over BlockNumber (_ - fromInt currentState.trailBy) chainHead 192 | in 193 | { nextEndBlock: min targetEnd nextAvailableBlock, finalBlock: Just targetEnd } 194 | isFinished = maybe false (\final -> currentBlock > final) finalBlock 195 | if isFinished then pure cs 196 | else if chainHead < currentBlock then waitForMoreBlocks 197 | else continueTo nextEndBlock 198 | 199 | where 200 | 201 | waitForMoreBlocks = do 202 | lift $ liftAff $ delay (Milliseconds 3000.0) 203 | filterProducer cs 204 | 205 | -- resume the filter production 206 | continueTo maxEndBlock = do 207 | let 208 | endBlock = min maxEndBlock $ over BlockNumber (_ + fromInt windowSize) currentBlock 209 | 210 | modify :: forall (k :: Type) (e :: k). Filter e -> Filter e 211 | modify fltr = 212 | fltr # _fromBlock .~ BN currentBlock 213 | # _toBlock .~ BN endBlock 214 | 215 | fs' = hmap (ModifyFilter modify) currentFilters 216 | yieldT fs' 217 | filterProducer $ MultiFilterStreamState currentState 218 | { currentBlock = succ endBlock 219 | } 220 | 221 | succ :: BlockNumber -> BlockNumber 222 | succ = over BlockNumber (_ + one) 223 | 224 | -- | Taking in a stream of filter records, produce a stream of `FilterChange`s from querying 225 | -- | the getLogs method. 226 | makeFilterChanges 227 | :: forall fs fsList r 228 | . RowList.RowToList fs fsList 229 | => FoldlRecord QueryAllLogs (Web3 (Array (FilterChange (Variant ())))) fsList fs (Web3 (Array (FilterChange (Variant r)))) 230 | => Transducer (Record fs) (Array (FilterChange (Variant r))) Web3 Unit 231 | makeFilterChanges = 232 | awaitForever \fltrs -> do 233 | changes <- lift $ hfoldlWithIndex QueryAllLogs (pure [] :: Web3 (Array (FilterChange (Variant ())))) fltrs 234 | yieldT $ sort changes 235 | 236 | -- | A stateless (on the server) stream of filter changes starting from an initial 237 | -- | filter record. 238 | logsStream 239 | :: forall fs fsList r 240 | . RowList.RowToList fs fsList 241 | => FoldlRecord MultiFilterMinToBlock ChainCursor fsList fs ChainCursor 242 | => MapRecordWithIndex fsList (ConstMapping ModifyFilter) fs fs 243 | => FoldlRecord QueryAllLogs (Web3 (Array (FilterChange (Variant ())))) fsList fs (Web3 (Array (FilterChange (Variant r)))) 244 | => MultiFilterStreamState fs 245 | -> Transducer Void (FilterChange (Variant r)) Web3 (MultiFilterStreamState fs) 246 | logsStream initialState = fst <$> (filterProducer initialState =>= stagger makeFilterChanges) 247 | 248 | -- | Aquire a record of server-side filters using the bracket operator to release the 249 | -- | filters on the node when done. 250 | aquireFilter 251 | :: forall fs fsList fsIds fsIdsList r b 252 | . RowList.RowToList fsIds fsIdsList 253 | => RowList.RowToList fs fsList 254 | => MapRecordWithIndex fsList (ConstMapping ModifyFilter) fs fs 255 | => FoldlRecord MultiFilterMinFromBlock ChainCursor fsList fs ChainCursor 256 | => FoldlRecord MultiFilterMinToBlock ChainCursor fsList fs ChainCursor 257 | => FoldlRecord OpenMultiFilter (Web3 (Record ())) fsList fs (Web3 (Record fsIds)) 258 | => FoldlRecord CloseMultiFilter (Web3 Unit) fsIdsList fsIds (Web3 Unit) 259 | => FoldlRecord CheckMultiFilter (Web3 (Array (FilterChange (Variant ())))) fsIdsList fsIds (Web3 (Array (FilterChange (Variant r)))) 260 | => Record fs 261 | -> (Record fsIds -> ChainCursor -> Web3 b) 262 | -> Web3 b 263 | aquireFilter fltrs hs = 264 | let 265 | pollingFromBlock = hfoldlWithIndex MultiFilterMinFromBlock Latest fltrs 266 | 267 | fltrs' = hmap (ModifyFilter (_ # _fromBlock .~ pollingFromBlock)) fltrs 268 | 269 | aquire = openMultiFilter fltrs' 270 | 271 | onRelease = const $ hfoldlWithIndex CloseMultiFilter (pure unit :: Web3 Unit) 272 | 273 | stopPollingAt = hfoldlWithIndex MultiFilterMinToBlock Latest fltrs 274 | 275 | withFilter fids = hs fids stopPollingAt 276 | in 277 | bracket aquire onRelease withFilter 278 | 279 | -- | `pollFilter` takes a `FilterId` and a max `ChainCursor` and polls a filter 280 | -- | for changes until the chainHead's `BlockNumber` exceeds the `ChainCursor`, 281 | -- | if ever. There is a minimum delay of 1 second between polls. 282 | pollFilter 283 | :: forall fidsList r fids 284 | . RowList.RowToList fids fidsList 285 | => FoldlRecord CheckMultiFilter (Web3 (Array (FilterChange (Variant ())))) fidsList fids (Web3 (Array (FilterChange (Variant r)))) 286 | => Record fids 287 | -> ChainCursor 288 | -> Transducer Void (Array (FilterChange (Variant r))) Web3 BlockNumber 289 | pollFilter fids stop = do 290 | fromProducer 291 | $ producer do 292 | bn <- eth_blockNumber 293 | if BN bn > stop then do 294 | pure <<< Right $ bn 295 | else do 296 | liftAff $ delay (Milliseconds 1000.0) 297 | changes <- hfoldlWithIndex CheckMultiFilter (pure [] :: Web3 (Array (FilterChange (Variant ())))) fids 298 | pure <<< Left $ sort changes 299 | 300 | -------------------------------------------------------------------------------- 301 | -- * Utils 302 | -------------------------------------------------------------------------------- 303 | -- | Takes a producer of filter changes and a record of handlers and runs the handlers 304 | -- | as a consumer. If one of the handlers chooses to `TerminateEvent`, we return 305 | -- | the change receipt that caused the termination. Otherwise if the producer 306 | -- | terminates and yields an `a`, we return that. 307 | reduceEventStream 308 | :: forall f par r handlers handlersList r1 a 309 | . Monad f 310 | => MonadRec f 311 | => Parallel par f 312 | => RowList.RowToList handlers handlersList 313 | => VariantMatchCases handlersList r1 (ReaderT Change f EventAction) 314 | => Row.Union r1 () r 315 | => Transducer Void (FilterChange (Variant r)) f a 316 | -> Record handlers 317 | -> Process f (Either a ChangeReceipt) 318 | reduceEventStream prod handlersR = (Right <$> eventRunner handlersR) `pullFrom` (Left <$> toProducer prod) 319 | 320 | processChange 321 | :: forall f r rl r1 r2 322 | . Monad f 323 | => RowList.RowToList r rl 324 | => VariantMatchCases rl r1 (ReaderT Change f EventAction) 325 | => Row.Union r1 () r2 326 | => Record r 327 | -> FilterChange (Variant r2) 328 | -> f ChangeReceipt 329 | processChange handlerRec (FilterChange { rawChange: rawChange@(Change change), event }) = do 330 | action <- runReaderT (match handlerRec event) rawChange 331 | pure 332 | { logIndex: change.logIndex 333 | , blockHash: change.blockHash 334 | , blockNumber: change.blockNumber 335 | , action 336 | } 337 | 338 | -- | Used to find the minimum `toBlock` among a record of filters. 339 | data MultiFilterMinToBlock = MultiFilterMinToBlock 340 | 341 | instance foldMinToBlock :: FoldingWithIndex MultiFilterMinToBlock (Proxy sym) ChainCursor (Filter e) ChainCursor where 342 | foldingWithIndex MultiFilterMinToBlock _ acc f = min acc (f ^. _toBlock) 343 | 344 | -- | Used to find the minimum `fromBlock` among a record of filters. 345 | data MultiFilterMinFromBlock = MultiFilterMinFromBlock 346 | 347 | instance foldMinFromBlock :: FoldingWithIndex MultiFilterMinFromBlock (Proxy sym) ChainCursor (Filter e) ChainCursor where 348 | foldingWithIndex MultiFilterMinFromBlock _ acc f = min acc (f ^. _fromBlock) 349 | 350 | -- data ModifyFilter :: Type 351 | data ModifyFilter = ModifyFilter (forall (k :: Type) (e :: k). Filter e -> Filter e) 352 | 353 | instance modifyFilter :: Mapping ModifyFilter (Filter e) (Filter e) where 354 | mapping (ModifyFilter f) filter = f filter 355 | 356 | -- | Parse an array of `Changes` into an array of `FilterChange`s 357 | -- | that contain this event. 358 | mkFilterChanges 359 | :: forall i ni e sym r b 360 | . DecodeEvent i ni e 361 | => Row.Cons sym e b r 362 | => IsSymbol sym 363 | => Proxy sym 364 | -> Proxy e 365 | -> Array Change 366 | -> Either Web3Error (Array (FilterChange (Variant r))) 367 | mkFilterChanges sp _ cs = traverse pairChange cs 368 | where 369 | pairChange rawChange = do 370 | a :: e <- decodeEvent rawChange 371 | pure 372 | $ FilterChange 373 | { rawChange: rawChange 374 | , event: inj sp a 375 | } 376 | 377 | -- | Used to query eth_getLogs for all the filters in record of filters. 378 | data QueryAllLogs = QueryAllLogs 379 | 380 | instance queryAllLogs :: 381 | ( DecodeEvent i ni e 382 | , IsSymbol sym 383 | , Row.Union r' b r 384 | , Row.Cons sym e r' r 385 | ) => 386 | FoldingWithIndex QueryAllLogs (Proxy sym) (Web3 (Array (FilterChange (Variant r')))) (Filter e) (Web3 (Array (FilterChange (Variant r)))) where 387 | foldingWithIndex QueryAllLogs (prop :: Proxy sym) acc filter = do 388 | eRes <- mkFilterChanges prop (Proxy :: Proxy e) <$> eth_getLogs (filter :: Filter e) 389 | case eRes of 390 | Left err -> throwWeb3 err 391 | Right changes -> (<>) changes <$> (map (map expand) <$> acc) 392 | 393 | data MultiFilterStreamState fs = MultiFilterStreamState 394 | { currentBlock :: BlockNumber 395 | , filters :: Record fs 396 | , windowSize :: Int 397 | , trailBy :: Int 398 | } 399 | 400 | data OpenMultiFilter = OpenMultiFilter 401 | 402 | instance openMultiFilterFold :: 403 | ( Row.Lacks sym r' 404 | , IsSymbol sym 405 | , Row.Union r' b r 406 | , Row.Cons sym (Tagged e FilterId) r' r 407 | ) => 408 | FoldingWithIndex OpenMultiFilter (Proxy sym) (Web3 (Record r')) (Filter e) (Web3 (Record r)) where 409 | foldingWithIndex OpenMultiFilter (prop :: Proxy sym) acc filter = do 410 | filterId <- eth_newFilter filter 411 | Record.insert prop (tagged filterId :: Tagged e FilterId) <$> acc 412 | 413 | openMultiFilter 414 | :: forall fs fis fsList 415 | . FoldlRecord OpenMultiFilter (Web3 (Record ())) fsList fs (Web3 (Record fis)) 416 | => RowList.RowToList fs fsList 417 | => Record fs 418 | -> Web3 (Record fis) 419 | openMultiFilter = hfoldlWithIndex OpenMultiFilter (pure {} :: Web3 (Record ())) 420 | 421 | data CheckMultiFilter = CheckMultiFilter 422 | 423 | instance checkMultiFilterLogs :: 424 | ( DecodeEvent i ni e 425 | , IsSymbol sym 426 | , Row.Union r' b r 427 | , Row.Cons sym e r' r 428 | ) => 429 | FoldingWithIndex CheckMultiFilter (Proxy sym) (Web3 (Array (FilterChange (Variant r')))) (Tagged e FilterId) (Web3 (Array (FilterChange (Variant r)))) where 430 | foldingWithIndex CheckMultiFilter (prop :: Proxy sym) acc filterId = do 431 | eRes <- mkFilterChanges prop (Proxy :: Proxy e) <$> eth_getFilterChanges (untagged filterId) 432 | case eRes of 433 | Left err -> throwWeb3 err 434 | Right changes -> (<>) changes <$> (map (map expand) <$> acc) 435 | 436 | data CloseMultiFilter = CloseMultiFilter 437 | 438 | instance closeMultiFilterFold :: 439 | ( IsSymbol sym 440 | ) => 441 | FoldingWithIndex CloseMultiFilter (Proxy sym) (Web3 Unit) (Tagged e FilterId) (Web3 Unit) where 442 | foldingWithIndex CloseMultiFilter (_ :: Proxy sym) acc filter = do 443 | void $ eth_uninstallFilter $ untagged filter 444 | acc 445 | 446 | -- Should belong to coroutines lib. 447 | stagger 448 | :: forall i o m a par 449 | . Monad m 450 | => MonadRec m 451 | => Parallel par m 452 | => Transducer i (Array o) m a 453 | -> Transducer i o m a 454 | stagger osT = 455 | let 456 | trickle = awaitForever \os -> 457 | for_ os yieldT 458 | in 459 | fst <$> (osT =>= trickle) 460 | -------------------------------------------------------------------------------- /src/Network/Ethereum/Web3/Types/Types.purs: -------------------------------------------------------------------------------- 1 | module Network.Ethereum.Web3.Types.Types 2 | ( BlockNumber(..) 3 | , ChainCursor(..) 4 | , Block(..) 5 | , Transaction(..) 6 | , TransactionReceipt(..) 7 | , TransactionStatus(..) 8 | , TransactionOptions(..) 9 | , defaultTransactionOptions 10 | , _from 11 | , _to 12 | , _data 13 | , _value 14 | , _gas 15 | , _gasPrice 16 | , _nonce 17 | , forkWeb3 18 | , forkWeb3' 19 | , runWeb3 20 | , Web3(..) 21 | , Web3Par 22 | , throwWeb3 23 | , Filter(..) 24 | , defaultFilter 25 | , _address 26 | , _topics 27 | , _fromBlock 28 | , _toBlock 29 | , FilterId(..) 30 | , EventAction(..) 31 | , Change(..) 32 | , FalseOrObject(..) 33 | , unFalseOrObject 34 | , SyncStatus(..) 35 | , MethodName 36 | , Request 37 | , mkRequest 38 | , Response(..) 39 | , Web3Error(..) 40 | , RpcError(..) 41 | , CallError(..) 42 | ) where 43 | 44 | import Prelude 45 | 46 | import Control.Alt (class Alt) 47 | import Control.Alternative (class Alternative, class Plus, (<|>)) 48 | import Control.Monad.Error.Class (class MonadError, class MonadThrow, catchError) 49 | import Control.Monad.Except (runExcept) 50 | import Control.Monad.Fork.Class (class MonadBracket, class MonadFork, class MonadKill, bracket, fork, join, kill, suspend, uninterruptible, never) as MFork 51 | import Control.Monad.Reader (class MonadAsk, class MonadReader, ReaderT, ask, lift, runReaderT) 52 | import Control.Monad.Rec.Class (class MonadRec) 53 | import Control.Parallel.Class (class Parallel, parallel, sequential) 54 | import Data.Argonaut as A 55 | import Data.Either (Either(..), hush) 56 | import Data.Generic.Rep (class Generic) 57 | import Data.Lens.Lens (Lens', Lens, lens) 58 | import Data.Maybe (Maybe(..), maybe) 59 | import Data.Newtype (class Newtype, unwrap) 60 | import Data.Ordering (invert) 61 | import Data.Show.Generic (genericShow) 62 | import Data.Tuple (Tuple(..)) 63 | import Effect.Aff (Aff, Fiber, ParAff, attempt, error, forkAff, message, throwError) 64 | import Effect.Aff.Class (class MonadAff, liftAff) 65 | import Effect.Class (class MonadEffect) 66 | import Effect.Exception (Error) 67 | import Foreign (F, Foreign, ForeignError(..), fail, isNull, readBoolean, readString) 68 | import Foreign.Index (readProp) 69 | import Foreign.Object as FO 70 | import Network.Ethereum.Types (Address, BigNumber, HexString) 71 | import Network.Ethereum.Web3.Types.EtherUnit (ETHER, Wei) 72 | import Network.Ethereum.Web3.Types.Provider (Provider) 73 | import Network.Ethereum.Web3.Types.TokenUnit (class TokenUnit, MinorUnit, NoPay, Value, convert) 74 | import Simple.JSON (class ReadForeign, class WriteForeign, readImpl, readJSON', undefined, writeImpl, writeJSON) 75 | 76 | -------------------------------------------------------------------------------- 77 | -- * Block 78 | -------------------------------------------------------------------------------- 79 | newtype BlockNumber = BlockNumber BigNumber 80 | 81 | derive instance genericBlockNumber :: Generic BlockNumber _ 82 | derive newtype instance showBlockNumber :: Show BlockNumber 83 | derive newtype instance eqBlockNumber :: Eq BlockNumber 84 | derive newtype instance ordBlockNumber :: Ord BlockNumber 85 | derive newtype instance readFBlockNumber :: ReadForeign BlockNumber 86 | derive newtype instance writeFBlockNumber :: WriteForeign BlockNumber 87 | derive instance newtypeBlockNumber :: Newtype BlockNumber _ 88 | 89 | instance A.EncodeJson BlockNumber where 90 | encodeJson (BlockNumber bn) = A.encodeJson bn 91 | 92 | instance A.DecodeJson BlockNumber where 93 | decodeJson = map BlockNumber <<< A.decodeJson 94 | 95 | -- | Refers to a particular block time, used when making calls, transactions, or watching for events. 96 | data ChainCursor 97 | = Latest 98 | | BN BlockNumber 99 | 100 | derive instance Generic ChainCursor _ 101 | derive instance Eq ChainCursor 102 | 103 | instance Show ChainCursor where 104 | show = genericShow 105 | 106 | instance Ord ChainCursor where 107 | compare Latest Latest = EQ 108 | compare (BN a) (BN b) = compare a b 109 | compare _ Latest = LT 110 | compare a b = invert $ compare b a 111 | 112 | instance ReadForeign ChainCursor where 113 | readImpl f = readLatest <|> readBN 114 | where 115 | readLatest = do 116 | s <- readString f 117 | if s == "latest" then 118 | pure Latest 119 | else 120 | fail (TypeMismatch "Latest" s) 121 | readBN = BN <$> readImpl f 122 | 123 | instance WriteForeign ChainCursor where 124 | writeImpl cm = case cm of 125 | Latest -> writeImpl "latest" 126 | BN n -> writeImpl n 127 | 128 | newtype Block = Block 129 | { difficulty :: BigNumber 130 | , extraData :: HexString 131 | , gasLimit :: BigNumber 132 | , gasUsed :: BigNumber 133 | , hash :: Maybe HexString 134 | , logsBloom :: Maybe HexString 135 | , miner :: HexString 136 | , nonce :: Maybe HexString 137 | , number :: Maybe BigNumber 138 | , parentHash :: HexString 139 | , receiptsRoot :: HexString 140 | , sha3Uncles :: HexString 141 | , size :: BigNumber 142 | , stateRoot :: HexString 143 | , timestamp :: BigNumber 144 | , totalDifficulty :: BigNumber 145 | , transactions :: Array HexString 146 | , transactionsRoot :: HexString 147 | , uncles :: Array HexString 148 | } 149 | 150 | derive instance Generic Block _ 151 | derive instance Newtype Block _ 152 | derive instance Eq Block 153 | derive newtype instance ReadForeign Block 154 | derive newtype instance WriteForeign Block 155 | 156 | instance Show Block where 157 | show = genericShow 158 | 159 | -------------------------------------------------------------------------------- 160 | -- * Transaction 161 | -------------------------------------------------------------------------------- 162 | newtype Transaction = Transaction 163 | { hash :: HexString 164 | , nonce :: BigNumber 165 | , blockHash :: Maybe HexString 166 | , blockNumber :: Maybe BlockNumber 167 | , transactionIndex :: Maybe BigNumber 168 | , from :: Address 169 | , to :: Maybe Address 170 | , value :: Value Wei 171 | , gas :: BigNumber 172 | , gasPrice :: BigNumber 173 | , input :: HexString 174 | } 175 | 176 | derive instance Generic Transaction _ 177 | derive instance Newtype Transaction _ 178 | derive newtype instance ReadForeign Transaction 179 | derive newtype instance WriteForeign Transaction 180 | derive instance Eq Transaction 181 | 182 | instance Show Transaction where 183 | show = genericShow 184 | 185 | -------------------------------------------------------------------------------- 186 | -- * TransactionReceipt 187 | -------------------------------------------------------------------------------- 188 | data TransactionStatus 189 | = Succeeded 190 | | Failed 191 | 192 | derive instance Generic TransactionStatus _ 193 | 194 | derive instance Eq TransactionStatus 195 | 196 | instance Show TransactionStatus where 197 | show = genericShow 198 | 199 | instance ReadForeign TransactionStatus where 200 | readImpl x = do 201 | str <- readString x 202 | case str of 203 | "0x1" -> pure Succeeded 204 | "0x0" -> pure Failed 205 | _ -> fail $ TypeMismatch "TransactionStatus" str 206 | 207 | instance WriteForeign TransactionStatus where 208 | writeImpl = case _ of 209 | Succeeded -> writeImpl "0x1" 210 | Failed -> writeImpl "0x0" 211 | 212 | newtype TransactionReceipt = TransactionReceipt 213 | { transactionHash :: HexString 214 | , transactionIndex :: BigNumber 215 | , blockHash :: HexString 216 | , blockNumber :: BlockNumber 217 | , cumulativeGasUsed :: BigNumber 218 | , gasUsed :: BigNumber 219 | , contractAddress :: Maybe Address 220 | , logs :: Array Change 221 | , status :: TransactionStatus 222 | } 223 | 224 | derive instance Generic TransactionReceipt _ 225 | derive instance Newtype TransactionReceipt _ 226 | derive instance Eq TransactionReceipt 227 | derive newtype instance ReadForeign TransactionReceipt 228 | derive newtype instance WriteForeign TransactionReceipt 229 | 230 | instance Show TransactionReceipt where 231 | show = genericShow 232 | 233 | -------------------------------------------------------------------------------- 234 | -- * TransactionOptions 235 | -------------------------------------------------------------------------------- 236 | newtype TransactionOptions u = TransactionOptions 237 | { from :: Maybe Address 238 | , to :: Maybe Address 239 | , value :: Maybe (Value (u ETHER)) 240 | , gas :: Maybe BigNumber 241 | , gasPrice :: Maybe BigNumber 242 | , data :: Maybe HexString 243 | , nonce :: Maybe BigNumber 244 | } 245 | 246 | derive instance Generic (TransactionOptions u) _ 247 | derive instance Newtype (TransactionOptions u) _ 248 | derive instance Eq (TransactionOptions u) 249 | 250 | instance Show (TransactionOptions u) where 251 | show = genericShow 252 | 253 | instance WriteForeign (Value (u ETHER)) => WriteForeign (TransactionOptions u) where 254 | writeImpl (TransactionOptions txOpts) = 255 | let 256 | encodeMaybe :: forall a. WriteForeign a => Maybe a -> Foreign 257 | encodeMaybe = maybe undefined writeImpl 258 | in 259 | writeImpl 260 | $ FO.fromFoldable 261 | [ Tuple "from" $ encodeMaybe txOpts.from 262 | , Tuple "to" $ encodeMaybe txOpts.to 263 | , Tuple "value" $ encodeMaybe txOpts.value 264 | , Tuple "gas" $ encodeMaybe txOpts.gas 265 | , Tuple "gasPrice" $ encodeMaybe txOpts.gasPrice 266 | , Tuple "data" $ encodeMaybe txOpts.data 267 | , Tuple "nonce" $ encodeMaybe txOpts.nonce 268 | ] 269 | 270 | defaultTransactionOptions :: TransactionOptions NoPay 271 | defaultTransactionOptions = 272 | TransactionOptions 273 | { from: Nothing 274 | , to: Nothing 275 | , value: Nothing 276 | , gas: Nothing 277 | , gasPrice: Nothing 278 | , data: Nothing 279 | , nonce: Nothing 280 | } 281 | 282 | -- * Lens Boilerplate 283 | _from :: forall u. Lens' (TransactionOptions u) (Maybe Address) 284 | _from = 285 | lens (\(TransactionOptions txOpt) -> txOpt.from) 286 | (\(TransactionOptions txOpts) addr -> TransactionOptions $ txOpts { from = addr }) 287 | 288 | _to :: forall u. Lens' (TransactionOptions u) (Maybe Address) 289 | _to = 290 | lens (\(TransactionOptions txOpt) -> txOpt.to) 291 | (\(TransactionOptions txOpts) addr -> TransactionOptions $ txOpts { to = addr }) 292 | 293 | _data :: forall u. Lens' (TransactionOptions u) (Maybe HexString) 294 | _data = 295 | lens (\(TransactionOptions txOpt) -> txOpt.data) 296 | (\(TransactionOptions txOpts) dat -> TransactionOptions $ txOpts { data = dat }) 297 | 298 | _value :: forall u. TokenUnit (Value (u ETHER)) => Lens (TransactionOptions u) (TransactionOptions MinorUnit) (Maybe (Value (u ETHER))) (Maybe (Value Wei)) 299 | _value = 300 | lens (\(TransactionOptions txOpt) -> txOpt.value) 301 | (\(TransactionOptions txOpts) val -> TransactionOptions $ txOpts { value = map convert val }) 302 | 303 | _gas :: forall u. Lens' (TransactionOptions u) (Maybe BigNumber) 304 | _gas = 305 | lens (\(TransactionOptions txOpt) -> txOpt.gas) 306 | (\(TransactionOptions txOpts) g -> TransactionOptions $ txOpts { gas = g }) 307 | 308 | _gasPrice :: forall u. Lens' (TransactionOptions u) (Maybe BigNumber) 309 | _gasPrice = 310 | lens (\(TransactionOptions txOpt) -> txOpt.gasPrice) 311 | (\(TransactionOptions txOpts) gp -> TransactionOptions $ txOpts { gasPrice = gp }) 312 | 313 | _nonce :: forall u. Lens' (TransactionOptions u) (Maybe BigNumber) 314 | _nonce = 315 | lens (\(TransactionOptions txOpt) -> txOpt.nonce) 316 | (\(TransactionOptions txOpts) n -> TransactionOptions $ txOpts { nonce = n }) 317 | 318 | -------------------------------------------------------------------------------- 319 | -- * Node Synchronisation 320 | -------------------------------------------------------------------------------- 321 | newtype SyncStatus = SyncStatus 322 | { startingBlock :: BigNumber 323 | , currentBlock :: BigNumber 324 | , highestBlock :: BigNumber 325 | } 326 | 327 | derive instance Generic SyncStatus _ 328 | derive instance Newtype SyncStatus _ 329 | derive instance Eq SyncStatus 330 | derive newtype instance ReadForeign SyncStatus 331 | derive newtype instance WriteForeign SyncStatus 332 | 333 | instance showSyncStatus :: Show SyncStatus where 334 | show = genericShow 335 | 336 | -------------------------------------------------------------------------------- 337 | -- * Web3 338 | -------------------------------------------------------------------------------- 339 | -- | A monad for asynchronous Web3 actions 340 | newtype Web3 a = Web3 (ReaderT Provider Aff a) 341 | 342 | unWeb3 :: Web3 ~> ReaderT Provider Aff 343 | unWeb3 (Web3 s) = s 344 | 345 | derive newtype instance Functor Web3 346 | derive newtype instance Apply Web3 347 | derive newtype instance Applicative Web3 348 | derive newtype instance Bind Web3 349 | derive newtype instance Monad Web3 350 | derive newtype instance MonadEffect Web3 351 | derive newtype instance MonadAff Web3 352 | derive newtype instance MonadThrow Error Web3 353 | derive newtype instance MonadError Error Web3 354 | derive newtype instance MonadAsk Provider Web3 355 | derive newtype instance MonadReader Provider Web3 356 | derive newtype instance MonadRec Web3 357 | 358 | instance MFork.MonadFork Fiber Web3 where 359 | suspend = Web3 <<< MFork.suspend <<< unWeb3 360 | fork = Web3 <<< MFork.fork <<< unWeb3 361 | join = Web3 <<< lift <<< MFork.join 362 | 363 | instance MFork.MonadKill Error Fiber Web3 where 364 | kill e = Web3 <<< MFork.kill e 365 | 366 | instance MFork.MonadBracket Error Fiber Web3 where 367 | bracket acquire release run = Web3 $ MFork.bracket (unWeb3 acquire) (\c a -> unWeb3 (release c a)) (\a -> unWeb3 (run a)) 368 | uninterruptible = Web3 <<< MFork.uninterruptible <<< unWeb3 369 | never = Web3 MFork.never 370 | 371 | newtype Web3Par a = Web3Par (ReaderT Provider ParAff a) 372 | 373 | derive newtype instance Functor Web3Par 374 | derive newtype instance Apply Web3Par 375 | derive newtype instance Applicative Web3Par 376 | derive newtype instance Alt Web3Par 377 | derive newtype instance Plus Web3Par 378 | derive newtype instance Alternative Web3Par 379 | 380 | instance Parallel Web3Par Web3 where 381 | parallel (Web3 m) = Web3Par (parallel m) 382 | sequential (Web3Par m) = Web3 (sequential m) 383 | 384 | -- | Run an asynchronous `ETH` action 385 | runWeb3 :: forall a. Provider -> Web3 a -> Aff (Either Web3Error a) 386 | runWeb3 p (Web3 action) = 387 | attempt (runReaderT action p) 388 | >>= case _ of 389 | Left err -> maybe (throwError err) (pure <<< Left) $ parseMsg $ message err 390 | Right x -> pure $ Right x 391 | where 392 | -- NOTE: it's a bit hacky 393 | -- for this to work, errors of type `Web3Error` should be converted to json 394 | -- using `genericEncodeJSON defaultOptions` and then Error 395 | -- should be created with json string as a message. 396 | -- see Network.Ethereum.Web3.JsonRPC#asError 397 | parseMsg :: String -> Maybe Web3Error 398 | parseMsg = hush <<< runExcept <<< readJSON' 399 | 400 | throwWeb3 :: forall a. Web3Error -> Web3 a 401 | throwWeb3 e = throwError $ error $ writeJSON e 402 | 403 | -- | Fork an asynchronous `ETH` action 404 | forkWeb3 405 | :: forall a 406 | . Provider 407 | -> Web3 a 408 | -> Aff (Fiber (Either Web3Error a)) 409 | forkWeb3 p = forkAff <<< runWeb3 p 410 | 411 | -- | Fork an asynchronous `ETH` action inside Web3 monad 412 | forkWeb3' :: forall a. Web3 a -> Web3 (Fiber (Either Web3Error a)) 413 | forkWeb3' web3Action = do 414 | p <- ask 415 | liftAff $ forkWeb3 p web3Action 416 | 417 | newtype Filter :: forall k. k -> Type 418 | newtype Filter a = Filter 419 | { address :: Maybe Address 420 | , topics :: Maybe (Array (Maybe HexString)) 421 | , fromBlock :: ChainCursor 422 | , toBlock :: ChainCursor 423 | } 424 | 425 | derive instance Generic (Filter a) _ 426 | derive instance Newtype (Filter a) _ 427 | derive instance Eq (Filter a) 428 | derive newtype instance ReadForeign (Filter a) 429 | derive newtype instance WriteForeign (Filter a) 430 | 431 | instance Show (Filter a) where 432 | show = genericShow 433 | 434 | defaultFilter :: forall a. Filter a 435 | defaultFilter = 436 | Filter 437 | { address: Nothing 438 | , topics: Nothing 439 | , fromBlock: Latest 440 | , toBlock: Latest 441 | } 442 | 443 | _address :: forall a. Lens' (Filter a) (Maybe Address) 444 | _address = 445 | lens (\(Filter f) -> f.address) 446 | (\(Filter f) addr -> Filter $ f { address = addr }) 447 | 448 | _topics :: forall a. Lens' (Filter a) (Maybe (Array (Maybe HexString))) 449 | _topics = 450 | lens (\(Filter f) -> f.topics) 451 | (\(Filter f) ts -> Filter $ f { topics = ts }) 452 | 453 | _fromBlock :: forall a. Lens' (Filter a) ChainCursor 454 | _fromBlock = 455 | lens (\(Filter f) -> f.fromBlock) 456 | (\(Filter f) b -> Filter $ f { fromBlock = b }) 457 | 458 | _toBlock :: forall a. Lens' (Filter a) ChainCursor 459 | _toBlock = 460 | lens (\(Filter f) -> f.toBlock) 461 | (\(Filter f) b -> Filter $ f { toBlock = b }) 462 | 463 | -- | Used by the ethereum client to identify the filter you are querying 464 | newtype FilterId = FilterId BigNumber 465 | 466 | derive instance Generic FilterId _ 467 | derive newtype instance ReadForeign FilterId 468 | derive newtype instance WriteForeign FilterId 469 | derive instance Eq FilterId 470 | 471 | instance Show FilterId where 472 | show = genericShow 473 | 474 | -------------------------------------------------------------------------------- 475 | -- | EventAction 476 | -------------------------------------------------------------------------------- 477 | -- | Represents a flag to continue or discontinue listening to the filter 478 | data EventAction 479 | = ContinueEvent 480 | -- ^ Continue to listen events 481 | | TerminateEvent 482 | 483 | -- ^ Terminate event listener 484 | derive instance Generic EventAction _ 485 | derive instance Eq EventAction 486 | 487 | instance Show EventAction where 488 | show = genericShow 489 | 490 | -------------------------------------------------------------------------------- 491 | -- * Raw Event Log Changes 492 | -------------------------------------------------------------------------------- 493 | -- | Changes pulled by low-level call `eth_getFilterChanges`, `eth_getLogs`, 494 | -- | and `eth_getFilterLogs` 495 | newtype Change = Change 496 | { logIndex :: BigNumber 497 | , transactionIndex :: BigNumber 498 | , transactionHash :: HexString 499 | , removed :: Boolean 500 | , blockHash :: HexString 501 | , blockNumber :: BlockNumber 502 | , address :: Address 503 | , data :: HexString 504 | , topics :: Array HexString 505 | } 506 | 507 | derive instance Generic Change _ 508 | derive instance Newtype Change _ 509 | derive newtype instance ReadForeign Change 510 | derive newtype instance WriteForeign Change 511 | derive instance Eq Change 512 | 513 | instance showChange :: Show Change where 514 | show = genericShow 515 | 516 | -------------------------------------------------------------------------------- 517 | -- * Json Decode Types 518 | -------------------------------------------------------------------------------- 519 | -- | Newtype wrapper around `Maybe` to handle cases where Web3 passes back 520 | -- | either `false` or some data type 521 | newtype FalseOrObject a = FalseOrObject (Maybe a) 522 | 523 | derive instance Newtype (FalseOrObject a) _ 524 | derive instance Eq a => Eq (FalseOrObject a) 525 | derive instance Ord a => Ord (FalseOrObject a) 526 | derive instance Generic (FalseOrObject a) _ 527 | 528 | instance showFalseOrObj :: Show a => Show (FalseOrObject a) where 529 | show x = "(FalseOrObject " <> show (unwrap x) <> ")" 530 | 531 | unFalseOrObject :: forall a. FalseOrObject a -> Maybe a 532 | unFalseOrObject (FalseOrObject a) = a 533 | 534 | readFalseOrObject :: forall a. (Foreign -> F a) -> Foreign -> F (FalseOrObject a) 535 | readFalseOrObject f value = do 536 | isBool <- catchError ((\_ -> true) <$> readBoolean value) (\_ -> pure false) 537 | if isBool then 538 | pure $ FalseOrObject Nothing 539 | else 540 | FalseOrObject <<< Just <$> f value 541 | 542 | instance ReadForeign a => ReadForeign (FalseOrObject a) where 543 | readImpl = readFalseOrObject readImpl 544 | 545 | -------------------------------------------------------------------------------- 546 | -- | Web3 RPC 547 | -------------------------------------------------------------------------------- 548 | type MethodName = String 549 | 550 | newtype Request = Request 551 | { jsonrpc :: String 552 | , id :: Int 553 | , method :: MethodName 554 | , params :: Array Foreign 555 | } 556 | 557 | derive newtype instance readFRequest :: ReadForeign Request 558 | derive newtype instance writeFRequest :: WriteForeign Request 559 | 560 | mkRequest :: MethodName -> Int -> Array Foreign -> Request 561 | mkRequest name reqId ps = 562 | Request 563 | { jsonrpc: "2.0" 564 | , id: reqId 565 | , method: name 566 | , params: ps 567 | } 568 | 569 | newtype Response a = Response (Either Web3Error a) 570 | 571 | instance ReadForeign a => ReadForeign (Response a) where 572 | readImpl a = Response <$> ((Left <$> readImpl a) <|> (Right <$> (readProp "result" a >>= readImpl))) 573 | 574 | -------------------------------------------------------------------------------- 575 | -- * Errors 576 | -------------------------------------------------------------------------------- 577 | data CallError = NullStorageError 578 | { signature :: String 579 | , _data :: HexString 580 | } 581 | 582 | derive instance Generic CallError _ 583 | derive instance Eq CallError 584 | 585 | instance showCallError :: Show CallError where 586 | show = genericShow 587 | 588 | newtype RpcError = RpcError 589 | { code :: Int 590 | , message :: String 591 | } 592 | 593 | derive instance Newtype RpcError _ 594 | derive instance Generic RpcError _ 595 | derive newtype instance ReadForeign RpcError 596 | derive newtype instance WriteForeign RpcError 597 | derive instance Eq RpcError 598 | 599 | instance showRpcError :: Show RpcError where 600 | show = genericShow 601 | 602 | data Web3Error 603 | = Rpc RpcError 604 | | RemoteError String 605 | | ParserError String 606 | | NullError 607 | 608 | derive instance Generic Web3Error _ 609 | derive instance Eq Web3Error 610 | 611 | instance Show Web3Error where 612 | show = genericShow 613 | 614 | instance ReadForeign Web3Error where 615 | readImpl x = remoteParser <|> parserErrorParser <|> rpcParser <|> nullParser 616 | where 617 | remoteParser = (map RemoteError $ readProp "_remoteError" x >>= readImpl) 618 | parserErrorParser = (map ParserError $ readProp "_parserError" x >>= readImpl) 619 | rpcParser = (map Rpc $ readProp "error" x >>= readImpl) 620 | nullParser = do 621 | res <- readProp "result" x 622 | if isNull res then 623 | pure NullError 624 | else 625 | readString res >>= \r -> fail (TypeMismatch "NullError" r) 626 | 627 | foreign import _null :: Foreign 628 | 629 | instance WriteForeign Web3Error where 630 | writeImpl x = case x of 631 | Rpc rpcErr -> writeImpl { error: rpcErr } 632 | NullError -> writeImpl { result: _null } 633 | RemoteError _remoteError -> writeImpl { _remoteError } 634 | ParserError _parserError -> writeImpl { _parserError } 635 | --------------------------------------------------------------------------------