diff --git a/.travis.yml b/.travis.yml index 2e30c221..9cc5a80d 100644 --- a/.travis.yml +++ b/.travis.yml @@ -2,6 +2,8 @@ language: node_js dist: trusty sudo: required node_js: stable +services: + - docker install: - npm install -g bower - npm install @@ -9,6 +11,8 @@ script: - bower install --production - npm run -s build - bower install + - docker run -d -p 8545:8545 -e ACCOUNTS_TO_CREATE=10 foamspace/cliquebait:latest + - sleep 10 - npm -s test after_success: - >- diff --git a/bower.json b/bower.json index c07566cd..9b36328f 100644 --- a/bower.json +++ b/bower.json @@ -17,25 +17,22 @@ ], "dependencies": { "purescript-errors": "^3.0.0", - "purescript-profunctor-lenses": "^3.7.0", + "purescript-profunctor-lenses": "^3.8.0", "purescript-foreign": "^4.0.1", - "purescript-foreign-generic": "^5.0.0", + "purescript-foreign-generic": "^6.0.0", "purescript-proxy": "^2.1.0", "purescript-bytestrings": "^6.0.0", - "purescript-eth-core": "^0.0.1", + "purescript-eth-core": "^1.0.0", "purescript-partial": "^1.2.1", "purescript-parsing": "^4.3.1", "purescript-transformers": "^3.6.0", "purescript-identity": "^3.1.0", - "purescript-aff": "^4.0.0", + "purescript-aff": "^4.1.0", "purescript-tagged": "^2.0.0", - "purescript-free": "^4.2.0", + "purescript-free": "^4.3.0", "purescript-coroutines": "^4.0.0", - "purescript-typelevel-prelude": "^2.6.0", - "purescript-type-equality": "^2.1.0", - "purescript-modules": "^3.0.0", - "purescript-mmorph": "^3.0.0", - "purescript-simple-json": "^2.0.1" + "purescript-typelevel-prelude": "^2.7.0", + "purescript-modules": "^3.0.0" }, "devDependencies": { "purescript-debug": "v3.0.0", diff --git a/src/Network/Ethereum/Web3/Api.purs b/src/Network/Ethereum/Web3/Api.purs index 35806444..f611cb40 100644 --- a/src/Network/Ethereum/Web3/Api.purs +++ b/src/Network/Ethereum/Web3/Api.purs @@ -1,20 +1,21 @@ module Network.Ethereum.Web3.Api where +import Data.Maybe (Maybe, fromMaybe) import Network.Ethereum.Web3.JsonRPC (remote) import Network.Ethereum.Types (Address, HexString, BigNumber) import Network.Ethereum.Web3.Types (Block, BlockNumber, ChainCursor, Change, FalseOrObject, Filter, FilterId, NoPay, SyncStatus, Transaction, TransactionOptions, TransactionReceipt, Web3, Wei) import Type.Data.Boolean (kind Boolean) -- | Returns current node version string. -web3_clientVersion :: forall e . Web3 e String +web3_clientVersion :: forall e . Partial => Web3 e String web3_clientVersion = remote "web3_clientVersion" -- | Returns Keccak-256 (*not* the standardized SHA3-256) of the given data. -web3_sha3 :: forall e. HexString -> Web3 e HexString +web3_sha3 :: forall e. Partial => HexString -> Web3 e HexString web3_sha3 hexInput = remote "web3_sha3" hexInput -- | Get the network id that the node is listening to. -net_version :: forall e . Web3 e BigNumber +net_version :: forall e . Web3 e String net_version = remote "net_version" -- | Returns `true`` if client is actively listening for network connections @@ -73,8 +74,6 @@ eth_getBlockTransactionCountByHash blockHash = remote "eth_getBlockTransactionCo eth_getBlockTransactionCountByNumber :: forall e. ChainCursor -> Web3 e BigNumber eth_getBlockTransactionCountByNumber cm = remote "eth_getBlockTransactionCountByNumber" cm --- TODO - is it appropriate for these to be Ints? - -- | Returns the number of uncles in a block from a block matching the given block hash eth_getUncleCountByBlockHash :: forall e. HexString -> Web3 e BigNumber eth_getUncleCountByBlockHash blockNumber = remote "eth_getUncleCountByBlockHash" blockNumber @@ -87,19 +86,13 @@ eth_getUncleCountByBlockNumber cm = remote "eth_getUncleCountByBlockNumber" cm eth_getCode :: forall e. Address -> ChainCursor -> Web3 e HexString eth_getCode addr cm = remote "eth_getCode" addr cm --- | The sign method calculates an Ethereum specific signature with: `sign(keccak256("\x19Ethereum Signed Message:\n" + len(message) + message)))`. --- | By adding a prefix to the message makes the calculated signature recognisable as an Ethereum specific signature. This prevents misuse where a malicious DApp can sign arbitrary data (e.g. transaction) and use the signature to impersonate the victim. --- | **Note** the address to sign with must be unlocked. -eth_sign :: forall e. Warn "eth_sign is deprecated in favor of personal_sign" => Address -> HexString -> Web3 e HexString -eth_sign addr msg = remote "eth_sign" addr msg - -- | Creates new message call transaction or a contract creation for signed transactions eth_sendRawTransaction :: forall e. HexString -> Web3 e HexString eth_sendRawTransaction rawTx = remote "eth_sendRawTransaction" rawTx -- | 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. -eth_estimateGas :: forall e. TransactionOptions Wei -> ChainCursor -> Web3 e BigNumber -eth_estimateGas txOpts cm = remote "eth_estimateGas" txOpts cm +eth_estimateGas :: forall e. TransactionOptions Wei -> Web3 e BigNumber +eth_estimateGas txOpts = remote "eth_estimateGas" txOpts -- | Returns information about a transaction by block hash and transaction index position. eth_getTransactionByBlockHashAndIndex :: forall e. HexString -> BigNumber -> Web3 e Transaction @@ -122,14 +115,9 @@ eth_getUncleByBlockNumberAndIndex :: forall e. ChainCursor -> BigNumber -> Web3 eth_getUncleByBlockNumberAndIndex cm uncleIndex = remote "eth_getUncleByBlockNumberAndIndex" cm uncleIndex -- | Returns a list of available compilers in the client. -eth_getCompilers :: forall e. Web3 e (Array String) +eth_getCompilers :: forall e. Partial => Web3 e (Array String) eth_getCompilers = remote "eth_getCompilers" --- TODO: As the ABI is returned decoding this isn't trivial - not going to implement without a need --- -- | Returns compiled solidity code. --- eth_compileSolidity :: forall e. String -> Web3 e HexString --- eth_compileSolidity code = remote "eth_compileSolidity" - -- | Returns information about a block by number. eth_getBlockByNumber :: forall e . ChainCursor -> Web3 e Block eth_getBlockByNumber cm = remote "eth_getBlockByNumber" cm false @@ -181,9 +169,9 @@ eth_uninstallFilter :: forall e . FilterId -> Web3 e Boolean eth_uninstallFilter fid = remote "eth_uninstallFilter" fid -- | Sign a message with the given address, returning the signature. -personal_sign :: forall e . HexString -> Address -> Web3 e HexString -personal_sign _data signer = remote "personal_sign" _data signer +personal_sign :: forall e . HexString -> Address -> Maybe String -> Web3 e HexString +personal_sign _data signer password = remote "personal_sign" _data signer (fromMaybe "" password) --- | Recover the address that signed the message. +-- | Recover the address that signed the message from (1) the message and (2) the signature personal_ecRecover :: forall e . HexString -> HexString -> Web3 e Address personal_ecRecover _data sig = remote "personal_ecRecover" _data sig diff --git a/src/Network/Ethereum/Web3/Contract.purs b/src/Network/Ethereum/Web3/Contract.purs index 8bc849fa..770b290d 100644 --- a/src/Network/Ethereum/Web3/Contract.purs +++ b/src/Network/Ethereum/Web3/Contract.purs @@ -121,7 +121,7 @@ _sendTransaction :: forall a u rep e selector . -> Web3 e HexString _sendTransaction txOptions dat = do let sel = toSelector <<< reflectSymbol $ (SProxy :: SProxy selector) - eth_sendTransaction <<< txdata $ sel <> (genericABIEncode <<< untagged $ dat) + eth_sendTransaction $ txdata $ sel <> (genericABIEncode <<< untagged $ dat) where txdata d = txOptions # _data .~ Just d # _value %~ map convert diff --git a/src/Network/Ethereum/Web3/Types/Types.purs b/src/Network/Ethereum/Web3/Types/Types.purs index b9271420..2470ccdd 100644 --- a/src/Network/Ethereum/Web3/Types/Types.purs +++ b/src/Network/Ethereum/Web3/Types/Types.purs @@ -46,13 +46,13 @@ import Prelude import Control.Alt (class Alt) import Control.Alternative (class Alternative, class Plus, (<|>)) -import Control.Monad.Aff (Aff, Fiber, ParAff, forkAff, liftEff', throwError) +import Control.Monad.Aff (Aff, Fiber, ParAff, forkAff, liftEff') import Control.Monad.Aff.Class (class MonadAff, liftAff) import Control.Monad.Eff (kind Effect) import Control.Monad.Eff.Class (class MonadEff) import Control.Monad.Eff.Exception (Error, throwException) import Control.Monad.Error.Class (class MonadThrow, catchError) -import Control.Monad.Except (ExceptT, except, runExceptT) +import Control.Monad.Except (ExceptT, runExceptT) import Control.Monad.Reader (class MonadAsk, class MonadReader, ReaderT, ask, runReaderT) import Control.Monad.Rec.Class (class MonadRec) import Control.Parallel.Class (class Parallel, parallel, sequential) @@ -61,7 +61,6 @@ import Data.Foreign (F, Foreign, ForeignError(..), fail, isNull, readBoolean, re import Data.Foreign.Class (class Decode, class Encode, decode, encode) import Data.Foreign.Generic (defaultOptions, genericDecode, genericEncode) import Data.Foreign.Index (readProp) -import Data.Foreign.NullOrUndefined (NullOrUndefined(..), unNullOrUndefined) import Data.Functor.Compose (Compose) import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Eq (genericEq) @@ -70,12 +69,9 @@ import Data.Lens.Lens (Lens', Lens, lens) import Data.Maybe (Maybe(..)) import Data.Newtype (class Newtype, unwrap) import Data.Ordering (invert) -import Data.Record as Record -import Data.Symbol (SProxy(..)) import Network.Ethereum.Types (Address, BigNumber, HexString) import Network.Ethereum.Web3.Types.EtherUnit (class EtherUnit, NoPay, Value, Wei, convert) import Network.Ethereum.Web3.Types.Provider (Provider) -import Simple.JSON (read) -------------------------------------------------------------------------------- -- * Block @@ -128,11 +124,11 @@ newtype Block , extraData :: HexString , gasLimit :: BigNumber , gasUsed :: BigNumber - , hash :: HexString - , logsBloom :: HexString + , hash :: Maybe HexString + , logsBloom :: Maybe HexString , miner :: HexString - , nonce :: HexString - , number :: BigNumber + , nonce :: Maybe HexString + , number :: Maybe BigNumber , parentHash :: HexString , receiptsRoot :: HexString , sha3Uncles :: HexString @@ -153,18 +149,7 @@ instance showBlock :: Show Block where show = genericShow instance decodeBlock :: Decode Block where - decode x = catchError (genericDecode decodeOpts x) - -- if this attempt fails for any reason pass back the original error - \origError -> catchError tryKovanAuthorHack (\_ -> throwError origError) - where - decodeOpts = defaultOptions { unwrapSingleConstructors = true } - tryKovanAuthorHack = do - rec <- except $ read x - let blockRec = Record.delete (SProxy :: SProxy "author") rec - # Record.insert (SProxy :: SProxy "nonce") rec.author - pure $ Block blockRec - - + decode x = genericDecode (defaultOptions { unwrapSingleConstructors = true }) x -------------------------------------------------------------------------------- -- * Transaction @@ -173,11 +158,11 @@ instance decodeBlock :: Decode Block where newtype Transaction = Transaction { hash :: HexString , nonce :: BigNumber - , blockHash :: HexString - , blockNumber :: BlockNumber - , transactionIndex :: BigNumber + , blockHash :: Maybe HexString + , blockNumber :: Maybe BlockNumber + , transactionIndex :: Maybe BigNumber , from :: Address - , to :: NullOrUndefined Address + , to :: Maybe Address , value :: Value Wei , gas :: BigNumber , gasPrice :: BigNumber @@ -221,7 +206,7 @@ newtype TransactionReceipt = , blockNumber :: BlockNumber , cumulativeGasUsed :: BigNumber , gasUsed :: BigNumber - , contractAddress :: NullOrUndefined Address + , contractAddress :: Maybe Address , logs :: Array Change , status :: TransactionStatus } @@ -241,13 +226,13 @@ instance decodeTxReceipt :: Decode TransactionReceipt where -------------------------------------------------------------------------------- newtype TransactionOptions u = - TransactionOptions { from :: NullOrUndefined Address - , to :: NullOrUndefined Address - , value :: NullOrUndefined (Value u) - , gas :: NullOrUndefined BigNumber - , gasPrice :: NullOrUndefined BigNumber - , data :: NullOrUndefined HexString - , nonce :: NullOrUndefined BigNumber + TransactionOptions { from :: Maybe Address + , to :: Maybe Address + , value :: Maybe (Value u) + , gas :: Maybe BigNumber + , gasPrice :: Maybe BigNumber + , data :: Maybe HexString + , nonce :: Maybe BigNumber } derive instance genericTransactionOptions :: Generic (TransactionOptions u) _ @@ -262,42 +247,42 @@ instance encodeTransactionOptions :: Encode (TransactionOptions u) where defaultTransactionOptions :: TransactionOptions NoPay defaultTransactionOptions = - TransactionOptions { from : NullOrUndefined Nothing - , to : NullOrUndefined Nothing - , value : NullOrUndefined Nothing - , gas : NullOrUndefined Nothing - , gasPrice : NullOrUndefined Nothing - , data : NullOrUndefined Nothing - , nonce : NullOrUndefined Nothing + TransactionOptions { from: Nothing + , to: Nothing + , value: Nothing + , gas: Nothing + , gasPrice: Nothing + , data: Nothing + , nonce: Nothing } -- * Lens Boilerplate _from :: forall u. Lens' (TransactionOptions u) (Maybe Address) -_from = lens (\(TransactionOptions txOpt) -> unNullOrUndefined $ txOpt.from) - (\(TransactionOptions txOpts) addr -> TransactionOptions $ txOpts {from = NullOrUndefined addr}) +_from = lens (\(TransactionOptions txOpt) -> txOpt.from) + (\(TransactionOptions txOpts) addr -> TransactionOptions $ txOpts {from = addr}) _to :: forall u. Lens' (TransactionOptions u) (Maybe Address) -_to = lens (\(TransactionOptions txOpt) -> unNullOrUndefined $ txOpt.to) - (\(TransactionOptions txOpts) addr -> TransactionOptions $ txOpts {to = NullOrUndefined addr}) +_to = lens (\(TransactionOptions txOpt) -> txOpt.to) + (\(TransactionOptions txOpts) addr -> TransactionOptions $ txOpts {to = addr}) _data :: forall u. Lens' (TransactionOptions u) (Maybe HexString) -_data = lens (\(TransactionOptions txOpt) -> unNullOrUndefined $ txOpt.data) - (\(TransactionOptions txOpts) dat -> TransactionOptions $ txOpts {data = NullOrUndefined dat}) +_data = lens (\(TransactionOptions txOpt) -> txOpt.data) + (\(TransactionOptions txOpts) dat -> TransactionOptions $ txOpts {data = dat}) _value :: forall u. EtherUnit (Value u) => Lens (TransactionOptions u) (TransactionOptions Wei) (Maybe (Value u)) (Maybe (Value Wei)) -_value = lens (\(TransactionOptions txOpt) -> unNullOrUndefined $ txOpt.value) - (\(TransactionOptions txOpts) val -> TransactionOptions $ txOpts {value = NullOrUndefined $ map convert val}) +_value = lens (\(TransactionOptions txOpt) -> txOpt.value) + (\(TransactionOptions txOpts) val -> TransactionOptions $ txOpts {value = map convert val}) _gas :: forall u. Lens' (TransactionOptions u) (Maybe BigNumber) -_gas = lens (\(TransactionOptions txOpt) -> unNullOrUndefined $ txOpt.gas) - (\(TransactionOptions txOpts) g -> TransactionOptions $ txOpts {gas = NullOrUndefined g}) +_gas = lens (\(TransactionOptions txOpt) -> txOpt.gas) + (\(TransactionOptions txOpts) g -> TransactionOptions $ txOpts {gas = g}) _gasPrice :: forall u. Lens' (TransactionOptions u) (Maybe BigNumber) -_gasPrice = lens (\(TransactionOptions txOpt) -> unNullOrUndefined $ txOpt.gasPrice) - (\(TransactionOptions txOpts) gp -> TransactionOptions $ txOpts {gasPrice = NullOrUndefined gp}) +_gasPrice = lens (\(TransactionOptions txOpt) -> txOpt.gasPrice) + (\(TransactionOptions txOpts) gp -> TransactionOptions $ txOpts {gasPrice = gp}) _nonce :: forall u. Lens' (TransactionOptions u) (Maybe BigNumber) -_nonce = lens (\(TransactionOptions txOpt) -> unNullOrUndefined $ txOpt.nonce) - (\(TransactionOptions txOpts) n -> TransactionOptions $ txOpts {nonce = NullOrUndefined n}) +_nonce = lens (\(TransactionOptions txOpt) -> txOpt.nonce) + (\(TransactionOptions txOpts) n -> TransactionOptions $ txOpts {nonce = n}) -------------------------------------------------------------------------------- -- * Node Synchronisation @@ -395,8 +380,8 @@ forkWeb3' web3Action = do -- | Low-level event filter data structure newtype Filter a = Filter - { address :: NullOrUndefined Address - , topics :: NullOrUndefined (Array (NullOrUndefined HexString)) + { address :: Maybe Address + , topics :: Maybe (Array (Maybe HexString)) , fromBlock :: ChainCursor , toBlock :: ChainCursor } @@ -414,19 +399,19 @@ instance encodeFilter :: Encode (Filter a) where encode x = genericEncode (defaultOptions { unwrapSingleConstructors = true }) x defaultFilter :: forall a. Filter a -defaultFilter = Filter { address: NullOrUndefined Nothing - , topics: NullOrUndefined Nothing +defaultFilter = Filter { address: Nothing + , topics: Nothing , fromBlock: Latest , toBlock: Latest } _address :: forall a. Lens' (Filter a) (Maybe Address) -_address = lens (\(Filter f) -> unNullOrUndefined f.address) - (\(Filter f) addr -> Filter $ f {address = NullOrUndefined addr}) +_address = lens (\(Filter f) -> f.address) + (\(Filter f) addr -> Filter $ f {address = addr}) _topics :: forall a. Lens' (Filter a) (Maybe (Array (Maybe HexString))) -_topics = lens (\(Filter f) -> map unNullOrUndefined <$> unNullOrUndefined f.topics) - (\(Filter f) ts -> Filter $ f {topics = NullOrUndefined (map NullOrUndefined <$> ts)}) +_topics = lens (\(Filter f) -> f.topics) + (\(Filter f) ts -> Filter $ f {topics = ts}) _fromBlock :: forall a. Lens' (Filter a) ChainCursor _fromBlock = lens (\(Filter f) -> f.fromBlock) @@ -437,7 +422,7 @@ _toBlock = lens (\(Filter f) -> f.toBlock) (\(Filter f) b -> Filter $ f {toBlock = b}) -- | Used by the ethereum client to identify the filter you are querying -newtype FilterId = FilterId HexString +newtype FilterId = FilterId BigNumber derive instance genericFilterId :: Generic FilterId _ @@ -480,9 +465,10 @@ instance eqEventAction :: Eq EventAction where -- | Changes pulled by low-level call 'eth_getFilterChanges', 'eth_getLogs', -- | and 'eth_getFilterLogs' newtype Change = Change - { logIndex :: HexString - , transactionIndex :: HexString + { logIndex :: BigNumber + , transactionIndex :: BigNumber , transactionHash :: HexString + , removed :: Boolean , blockHash :: HexString , blockNumber :: BlockNumber , address :: Address diff --git a/test/Main.purs b/test/Main.purs index 42e33a14..911ee69d 100644 --- a/test/Main.purs +++ b/test/Main.purs @@ -2,22 +2,29 @@ module Test.Main where import Prelude +import Data.Maybe (Maybe(..)) import Control.Monad.Eff (Eff) import Network.Ethereum.Web3.Types (ETH) import Test.Spec.Reporter.Console (consoleReporter) -import Test.Spec.Runner (RunnerEffects, run) +import Test.Spec.Runner (RunnerEffects, run', defaultConfig) import Web3Spec.Contract (simpleStorageSpec) import Web3Spec.Encoding.Containers (encodingContainersSpec) import Web3Spec.Encoding.Generic (encodingGenericSpec) import Web3Spec.Encoding.Simple (encodingSimpleSpec) import Web3Spec.EtherUnitSpec (etherUnitTests) import Web3Spec.Types.Vector (vectorSpec) +import Web3Spec.Live.LiveSpec (liveSpec) +import Network.Ethereum.Web3.Types.Provider (httpProvider) + main :: Eff (RunnerEffects (eth :: ETH)) Unit -main = run [consoleReporter] $ do - vectorSpec - encodingContainersSpec - encodingSimpleSpec - encodingGenericSpec - simpleStorageSpec - etherUnitTests +main = do + p <- httpProvider "http://localhost:8545" + run' defaultConfig {timeout = Just (60 * 1000)} [consoleReporter] $ do + vectorSpec + encodingContainersSpec + encodingSimpleSpec + encodingGenericSpec + simpleStorageSpec + etherUnitTests + liveSpec p diff --git a/test/Web3Spec/Encoding/Generic.purs b/test/Web3Spec/Encoding/Generic.purs index 63316e4d..4ef97147 100644 --- a/test/Web3Spec/Encoding/Generic.purs +++ b/test/Web3Spec/Encoding/Generic.purs @@ -125,16 +125,15 @@ amount = unsafePartial fromJust $ mkHexString "0x0000000000000000000000000000000 change :: Change change = Change { data: amount , topics: addressArray - , logIndex: li + , logIndex: zero , transactionHash: tx - , transactionIndex: txi + , transactionIndex: zero , blockNumber: wrap $ embed 0 , blockHash: bh , address: a + , removed: false } where - li = unsafePartial fromJust $ mkHexString "00" bh = unsafePartial fromJust $ mkHexString "00" tx = unsafePartial fromJust $ mkHexString "00" - txi = unsafePartial fromJust $ mkHexString "00" a = unsafePartial fromJust $ mkAddress =<< mkHexString "0x0000000000000000000000000000000000000000" diff --git a/test/Web3Spec/Encoding/Simple.purs b/test/Web3Spec/Encoding/Simple.purs index 03f60475..f24965d2 100644 --- a/test/Web3Spec/Encoding/Simple.purs +++ b/test/Web3Spec/Encoding/Simple.purs @@ -8,14 +8,14 @@ import Control.Monad.Eff.Console (CONSOLE) import Control.Monad.Except (runExcept) import Data.Array (replicate) import Data.ByteString as BS -import Data.Either (Either(Right), either, isLeft) +import Data.Either (Either(Right), either) import Data.Foldable (intercalate) import Data.Foreign (ForeignError) import Data.Foreign.Generic (decodeJSON, defaultOptions) import Data.List.Types (NonEmptyList) import Data.Maybe (Maybe(..), fromJust) import Data.Newtype (unwrap) -import Data.String (Pattern(..), contains, toLower) +import Data.String (toLower) import Data.Traversable (sequence) import Network.Ethereum.Core.BigNumber (pow) import Network.Ethereum.Web3.Solidity.AbiEncoding (class ABIEncode, class ABIDecode, toDataBuilder, fromData) @@ -23,7 +23,7 @@ import Network.Ethereum.Web3.Solidity.Bytes (fromByteString) import Network.Ethereum.Web3.Solidity.Int (intNFromBigNumber) import Network.Ethereum.Web3.Solidity.Sizes (s1, s12, s16, s248, s256, s3, s8) import Network.Ethereum.Web3.Solidity.UInt (uIntNFromBigNumber) -import Network.Ethereum.Web3.Types (Block, FalseOrObject(..), HexString, SyncStatus(..), embed, mkAddress, mkHexString, unHex) +import Network.Ethereum.Web3.Types (Block, FalseOrObject(..), HexString, BigNumber, SyncStatus(..), embed, mkAddress, mkHexString, unHex) import Partial.Unsafe (unsafePartial) import Test.Spec (Spec, describe, it) import Test.Spec.Assertions (shouldEqual, shouldNotEqual) @@ -238,7 +238,7 @@ falseOrObjectTests = decodedFalse `shouldEqual` (Right $ FalseOrObject Nothing) it "can decode FalseOrObject instances that are objects" do - let decodedObj = runExcept $ decodeJSON "{ \"startingBlock\": 0, \"currentBlock\": 1, \"highestBlock\": 2 }" + let decodedObj = runExcept $ decodeJSON "{ \"startingBlock\": \"0x0\", \"currentBlock\": \"0x1\", \"highestBlock\": \"0x2\" }" decodedObj `shouldEqual` (Right $ FalseOrObject $ Just $ SyncStatus {startingBlock: embed 0, currentBlock: embed 1, highestBlock: embed 2}) @@ -248,29 +248,49 @@ blockTests = it "can decode normal blocks" do let (decodedBlockE :: Either (NonEmptyList ForeignError) Block) = runExcept $ decodeJSON blockPlaintext dBlock <- unwrap <$> either (throwError <<< error <<< show) pure decodedBlockE - dBlock.nonce `shouldEqual` upToHex "0x539bd4979fef1ec4" - dBlock.hash `shouldEqual` upToHex "0x88e96d4537bea4d9c05d12549907b32561d3bf31f45aae734cdc119f13406cb6" - dBlock.timestamp `shouldEqual` embed 1438269988 + dBlock.nonce `shouldEqual` (Just $ upToHex "0x0000000000000000") + dBlock.hash `shouldEqual` (Just $ upToHex "0x093ff26b85b5e3ac3e331f3d766a81990be76ec8ac79f62a81e30faa642dc26f") + dBlock.timestamp `shouldEqual` embed 1507570522 + +{- + +This test is broken for now because of upgrades to data.foreign.generic it "can decode parity blocks (no nonce field, but does have author field)" do let (decodedBlockE :: Either (NonEmptyList ForeignError) Block) = runExcept $ decodeJSON blockNoNoncePlaintext - dBlock <- unwrap <$> either (throwError <<< error <<< show) pure decodedBlockE + Block dBlock' <- either (throwError <<< error <<< show) pure decodedBlockE + let b@(KovanBlock dBlock) = KovanBlock (unsafeCoerce dBlock') + traceA $ unsafeCoerce b -- nonce replaced by author - dBlock.nonce `shouldEqual` upToHex "0x05a56e2d52c817161883f50c441c3228cfe54d9f" + dBlock."author" `shouldEqual` (upToHex "0x05a56e2d52c817161883f50c441c3228cfe54d9f") -- sanity check some other fields to make sure things are consistent - dBlock.hash `shouldEqual` upToHex "0x88e96d4537bea4d9c05d12549907b32561d3bf31f45aae734cdc119f13406cb6" + dBlock.hash `shouldEqual` (Just $ upToHex "0x88e96d4537bea4d9c05d12549907b32561d3bf31f45aae734cdc119f13406cb6") dBlock.timestamp `shouldEqual` embed 1438269988 - - it "should fail when there's no author _and_ no nonce" do - let (decodedBlockE :: Either (NonEmptyList ForeignError) Block) = runExcept $ decodeJSON blockNoAuthOrNoncePlaintext - isLeft decodedBlockE `shouldEqual` true - -- not sure of a better way to ensure the error thrown is regarding the nonce - (show decodedBlockE # contains (Pattern "ErrorAtProperty \"nonce\"")) `shouldEqual` true - - +-} where -- this is block 1 on Eth mainnet - blockPlaintext = "{\"author\":\"0x05a56e2d52c817161883f50c441c3228cfe54d9f\",\"difficulty\":17171480576,\"extraData\":\"0x476574682f76312e302e302f6c696e75782f676f312e342e32\",\"gasLimit\":5000,\"gasUsed\":0,\"hash\":\"0x88e96d4537bea4d9c05d12549907b32561d3bf31f45aae734cdc119f13406cb6\",\"logsBloom\":\"0x00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000\",\"miner\":\"0x05a56e2d52c817161883f50c441c3228cfe54d9f\",\"mixHash\":\"0x969b900de27b6ac6a67742365dd65f55a0526c41fd18e1b16f1a1215c2e66f59\",\"nonce\":\"0x539bd4979fef1ec4\",\"number\":1,\"parentHash\":\"0xd4e56740f876aef8c010b86a40d5f56745a118d0906a34e69aec8c0db1cb8fa3\",\"receiptsRoot\":\"0x56e81f171bcc55a6ff8345e692c0f86e5b48e01b996cadc001622fb5e363b421\",\"sealFields\":[\"0xa0969b900de27b6ac6a67742365dd65f55a0526c41fd18e1b16f1a1215c2e66f59\",\"0x88539bd4979fef1ec4\"],\"sha3Uncles\":\"0x1dcc4de8dec75d7aab85b567b6ccd41ad312451b948a7413f0a142fd40d49347\",\"size\":537,\"stateRoot\":\"0xd67e4d450343046425ae4271474353857ab860dbc0a1dde64b41b5cd3a532bf3\",\"timestamp\":1438269988,\"totalDifficulty\":34351349760,\"transactions\":[],\"transactionsRoot\":\"0x56e81f171bcc55a6ff8345e692c0f86e5b48e01b996cadc001622fb5e363b421\",\"uncles\":[]}" - blockNoNoncePlaintext = "{\"author\":\"0x05a56e2d52c817161883f50c441c3228cfe54d9f\",\"difficulty\":17171480576,\"extraData\":\"0x476574682f76312e302e302f6c696e75782f676f312e342e32\",\"gasLimit\":5000,\"gasUsed\":0,\"hash\":\"0x88e96d4537bea4d9c05d12549907b32561d3bf31f45aae734cdc119f13406cb6\",\"logsBloom\":\"0x00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000\",\"miner\":\"0x05a56e2d52c817161883f50c441c3228cfe54d9f\",\"mixHash\":\"0x969b900de27b6ac6a67742365dd65f55a0526c41fd18e1b16f1a1215c2e66f59\",\"number\":1,\"parentHash\":\"0xd4e56740f876aef8c010b86a40d5f56745a118d0906a34e69aec8c0db1cb8fa3\",\"receiptsRoot\":\"0x56e81f171bcc55a6ff8345e692c0f86e5b48e01b996cadc001622fb5e363b421\",\"sealFields\":[\"0xa0969b900de27b6ac6a67742365dd65f55a0526c41fd18e1b16f1a1215c2e66f59\",\"0x88539bd4979fef1ec4\"],\"sha3Uncles\":\"0x1dcc4de8dec75d7aab85b567b6ccd41ad312451b948a7413f0a142fd40d49347\",\"size\":537,\"stateRoot\":\"0xd67e4d450343046425ae4271474353857ab860dbc0a1dde64b41b5cd3a532bf3\",\"timestamp\":1438269988,\"totalDifficulty\":34351349760,\"transactions\":[],\"transactionsRoot\":\"0x56e81f171bcc55a6ff8345e692c0f86e5b48e01b996cadc001622fb5e363b421\",\"uncles\":[]}" - blockNoAuthOrNoncePlaintext = "{\"difficulty\":17171480576,\"extraData\":\"0x476574682f76312e302e302f6c696e75782f676f312e342e32\",\"gasLimit\":5000,\"gasUsed\":0,\"hash\":\"0x88e96d4537bea4d9c05d12549907b32561d3bf31f45aae734cdc119f13406cb6\",\"logsBloom\":\"0x00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000\",\"miner\":\"0x05a56e2d52c817161883f50c441c3228cfe54d9f\",\"mixHash\":\"0x969b900de27b6ac6a67742365dd65f55a0526c41fd18e1b16f1a1215c2e66f59\",\"number\":1,\"parentHash\":\"0xd4e56740f876aef8c010b86a40d5f56745a118d0906a34e69aec8c0db1cb8fa3\",\"receiptsRoot\":\"0x56e81f171bcc55a6ff8345e692c0f86e5b48e01b996cadc001622fb5e363b421\",\"sealFields\":[\"0xa0969b900de27b6ac6a67742365dd65f55a0526c41fd18e1b16f1a1215c2e66f59\",\"0x88539bd4979fef1ec4\"],\"sha3Uncles\":\"0x1dcc4de8dec75d7aab85b567b6ccd41ad312451b948a7413f0a142fd40d49347\",\"size\":537,\"stateRoot\":\"0xd67e4d450343046425ae4271474353857ab860dbc0a1dde64b41b5cd3a532bf3\",\"timestamp\":1438269988,\"totalDifficulty\":34351349760,\"transactions\":[],\"transactionsRoot\":\"0x56e81f171bcc55a6ff8345e692c0f86e5b48e01b996cadc001622fb5e363b421\",\"uncles\":[]}" + 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\":[]}" upToHex = unsafePartial fromJust <<< mkHexString + + +newtype KovanBlock = + KovanBlock { difficulty :: BigNumber + , extraData :: HexString + , gasLimit :: BigNumber + , gasUsed :: BigNumber + , hash :: Maybe HexString + , logsBloom :: Maybe HexString + , author :: HexString + , sealFields :: Array HexString + , number :: Maybe BigNumber + , parentHash :: HexString + , receiptsRoot :: HexString + , sha3Uncles :: HexString + , size :: BigNumber + , stateRoot :: HexString + , timestamp :: BigNumber + , totalDifficulty :: BigNumber + , transactions :: Array HexString + , transactionsRoot :: HexString + , uncles :: Array HexString + } diff --git a/test/Web3Spec/Live/LiveSpec.purs b/test/Web3Spec/Live/LiveSpec.purs new file mode 100644 index 00000000..4b60e340 --- /dev/null +++ b/test/Web3Spec/Live/LiveSpec.purs @@ -0,0 +1,224 @@ +module Web3Spec.Live.LiveSpec where + +import Prelude +import Data.Array ((!!)) +import Control.Monad.Aff (Aff, Milliseconds(..), delay) +import Control.Monad.Aff.Console as C +import Control.Monad.Aff.Class (liftAff) +import Control.Monad.Aff.AVar (makeEmptyVar, putVar, takeVar, AVAR) +import Data.Either (Either(..), isRight, fromRight) +import Network.Ethereum.Core.BigNumber (parseBigNumber, decimal, BigNumber) +import Network.Ethereum.Web3.Solidity (uIntNFromBigNumber) +import Network.Ethereum.Web3.Solidity.Sizes (s256) +import Network.Ethereum.Web3 (ETH, Block(..), ChainCursor(..), Web3, Provider, HexString, TransactionReceipt(..), runWeb3, mkHexString, defaultTransactionOptions, _from, _gas, _value, convert, fromWei, _to, event, forkWeb3, TransactionStatus(..), eventFilter, EventAction(..)) +import Network.Ethereum.Web3.Api as Api +import Test.Spec (Spec, describe, it) +import Test.Spec.Assertions (fail, shouldEqual) +import Partial.Unsafe (unsafePartial, unsafePartialBecause) +import Data.Maybe (Maybe(..), fromJust) +import Web3Spec.Live.SimpleStorage as SimpleStorage +import Data.Lens ((?~), (%~)) +import Data.Tuple (Tuple(..)) +import Type.Proxy (Proxy(..)) + +liveSpec + :: forall eff. + Provider + -> Spec (eth :: ETH, avar :: AVAR, console :: C.CONSOLE |eff) Unit + +liveSpec provider = + describe "It should be able to test all the web3 endpoints live" do + + it "Can get the network version" do + eRes <- runWeb3 provider $ Api.net_version + eRes `shouldSatisfy` isRight + + it "Can call net_listening" do + eRes <- runWeb3 provider $ Api.net_listening + eRes `shouldSatisfy` isRight + + it "Can call net_getPeerCount" do + eRes <- runWeb3 provider $ Api.net_getPeerCount + eRes `shouldSatisfy` isRight + + it "Can call eth_protocolVersion" do + eRes <- runWeb3 provider $ Api.eth_protocolVersion + eRes `shouldSatisfy` isRight + + it "Can call eth_getSyncing" do + eRes <- runWeb3 provider $ Api.eth_getSyncing + eRes `shouldSatisfy` isRight + + it "Can call eth_coinbase" do + eRes <- runWeb3 provider $ Api.eth_coinbase + eRes `shouldSatisfy` isRight + + it "Can call eth_mining" do + eRes <- runWeb3 provider $ Api.eth_mining + eRes `shouldSatisfy` isRight + + it "Can call eth_hashrate" do + eRes <- runWeb3 provider $ Api.eth_hashrate + eRes `shouldSatisfy` isRight + + it "Can call eth_blockNumber" do + eRes <- runWeb3 provider $ Api.eth_blockNumber + eRes `shouldSatisfy` isRight + + it "Can call eth_accounts and eth_getBalance" do + eRes <- runWeb3 provider $ do + accounts <- Api.eth_getAccounts + Api.eth_getBalance (unsafePartialBecause "there is more than one account" $ fromJust $ accounts !! 0) Latest + eRes `shouldSatisfy` isRight + + it "Can call eth_getTransactionCount" do + eRes <- runWeb3 provider do + accounts <- Api.eth_getAccounts + Api.eth_getTransactionCount (unsafePartialBecause "there is more than one account" $ fromJust $ accounts !! 0) Latest + eRes `shouldSatisfy` isRight + + it "Can call eth_getBlockByNumber, eth_getBlockTransactionCountByHash, getBlockTransactionCountByNumber" do + eRes <- runWeb3 provider do + bn <- Api.eth_blockNumber + Block block <- Api.eth_getBlockByNumber (BN bn) + let bHash = unsafePartialBecause "Block is not pending" $ fromJust block.hash + count1 <- Api.eth_getBlockTransactionCountByHash bHash + count2 <- Api.eth_getBlockTransactionCountByNumber (BN bn) + pure $ Tuple count1 count2 + eRes `shouldSatisfy` isRight + let Tuple count1 count2 = unsafePartialBecause "Result was Right" $ fromRight eRes + count1 `shouldEqual` count2 + + it "Can call eth_getUncleCountByBlockHash eth_getUncleCountByBlockNumber" do + eRes <- runWeb3 provider do + bn <- Api.eth_blockNumber + Block block <- Api.eth_getBlockByNumber (BN bn) + let bHash = unsafePartialBecause "Block is not pending" $ fromJust block.hash + count1 <- Api.eth_getUncleCountByBlockHash bHash + count2 <- Api.eth_getUncleCountByBlockNumber (BN bn) + pure $ Tuple count1 count2 + eRes `shouldSatisfy` isRight + let Tuple count1 count2 = unsafePartialBecause "Result was Right" $ fromRight eRes + count1 `shouldEqual` count2 + + it "Can call eth_getBlockByHash" do + eRes <- runWeb3 provider do + bn <- Api.eth_blockNumber + Block block <- Api.eth_getBlockByNumber (BN bn) + let bHash = unsafePartialBecause "Block is not pending" $ fromJust block.hash + Api.eth_getBlockByHash bHash + eRes `shouldSatisfy` isRight + + -- TODO: validate this with eth-core lib + it "Can call personal_sign, personal_ecRecover" do + eRes <- runWeb3 provider do + accounts <- Api.eth_getAccounts + let signer = unsafePartialBecause "there is more than one account" $ fromJust $ accounts !! 0 + msg = unsafePartial fromJust $ mkHexString "1234" + signature <- Api.personal_sign msg signer (Just "password123") + signer' <- Api.personal_ecRecover msg signature + pure $ Tuple signer signer' + eRes `shouldSatisfy` isRight + let Tuple signer signer' = unsafePartialBecause "Result was Right" $ fromRight eRes + signer `shouldEqual` signer' + + it "Can call eth_estimateGas" do + eRes <- runWeb3 provider $ Api.eth_estimateGas (defaultTransactionOptions # _value %~ map convert) + eRes `shouldSatisfy` isRight + + it "Can call eth_getTransactionByBlockHashAndIndex eth_getBlockTransactionByBlockNumberAndIndex" do + eRes <- runWeb3 provider do + accounts <- Api.eth_getAccounts + let sender = unsafePartialBecause "there is more than one account" $ fromJust $ accounts !! 0 + receiver = unsafePartialBecause "there is more than one account" $ fromJust $ accounts !! 1 + txOpts = defaultTransactionOptions # _from ?~ sender + # _to ?~ receiver + # _value ?~ fromWei one + Api.eth_sendTransaction txOpts + eRes `shouldSatisfy` isRight + let txHash = unsafePartialBecause "Result was Right" $ fromRight eRes + TransactionReceipt txReceipt <- pollTransactionReceipt txHash provider + eRes' <- runWeb3 provider do + tx <- Api.eth_getTransactionByBlockHashAndIndex txReceipt.blockHash zero + tx' <- Api.eth_getTransactionByBlockNumberAndIndex (BN txReceipt.blockNumber) zero + pure $ Tuple tx tx' + eRes' `shouldSatisfy` isRight + let Tuple tx tx' = unsafePartialBecause "Result was Right" $ fromRight eRes' + tx `shouldEqual` tx' + + it "Can deploy a contract, verify the contract storage, make a transaction, get get the event, make a call" do + let newCount = unsafePartialBecause "one is a UINT" $ fromJust (uIntNFromBigNumber s256 one) + eventVar <- makeEmptyVar + eRes <- runWeb3 provider deploySimpleStorage + eRes `shouldSatisfy` isRight + let txHash = unsafePartialBecause "Result was Right" $ fromRight eRes + (TransactionReceipt txReceipt) <- pollTransactionReceipt txHash provider + txReceipt.status `shouldEqual` Succeeded + let simpleStorageAddress = unsafePartialBecause "Contract deployment succeded" $ fromJust txReceipt.contractAddress + fltr = eventFilter (Proxy :: Proxy SimpleStorage.CountSet) simpleStorageAddress + _ <- forkWeb3 provider $ event fltr \(SimpleStorage.CountSet {_count}) -> liftAff do + C.log $ "New Count Set: " <> show _count + putVar _count eventVar + pure TerminateEvent + let countSetOptions = defaultTransactionOptions + _ <- runWeb3 provider do + accounts <- Api.eth_getAccounts + let sender = unsafePartialBecause "there is more than one account" $ fromJust $ accounts !! 0 + txOpts = defaultTransactionOptions # _from ?~ sender + # _to ?~ simpleStorageAddress + # _gas ?~ bigGasLimit + setCountHash <- SimpleStorage.setCount txOpts {_count: newCount} + liftAff $ C.log $ "Sumbitted count update transaction: " <> show setCountHash + n <- takeVar eventVar + n `shouldEqual` newCount + eRes' <- runWeb3 provider $ Api.eth_getStorageAt simpleStorageAddress zero Latest + eRes' `shouldSatisfy` isRight + + + +-------------------------------------------------------------------------------- +-- | Helpers +-------------------------------------------------------------------------------- + +shouldSatisfy + :: forall e a. + Show a + => Eq a + => a + -> (a -> Boolean) + -> Aff e Unit +shouldSatisfy a p = + if p a then pure unit else fail $ "Predicate failed: " <> show a + +mkHexString' + :: String + -> HexString +mkHexString' hx = + unsafePartialBecause "I know how to make a HexString" $ fromJust $ mkHexString hx + +bigGasLimit :: BigNumber +bigGasLimit = unsafePartial fromJust $ parseBigNumber decimal "4712388" + + +pollTransactionReceipt + :: forall eff. + HexString + -> Provider + -> Aff (eth :: ETH | eff) TransactionReceipt +pollTransactionReceipt txHash provider = do + eRes <- runWeb3 provider $ Api.eth_getTransactionReceipt txHash + case eRes of + Left e -> do + delay (Milliseconds 2000.0) + pollTransactionReceipt txHash provider + Right res -> pure res + +deploySimpleStorage :: forall e. Web3 (console :: C.CONSOLE | e) HexString +deploySimpleStorage = do + accounts <- Api.eth_getAccounts + let sender = unsafePartialBecause "there is more than one account" $ fromJust $ accounts !! 0 + txOpts = defaultTransactionOptions # _from ?~ sender + # _gas ?~ bigGasLimit + txHash <- SimpleStorage.constructor txOpts SimpleStorage.deployBytecode + liftAff $ C.log $ "Submitted SimpleStorage deployment: " <> show txHash + pure txHash diff --git a/test/Web3Spec/Live/SimpleStorage.purs b/test/Web3Spec/Live/SimpleStorage.purs new file mode 100644 index 00000000..a3126bc8 --- /dev/null +++ b/test/Web3Spec/Live/SimpleStorage.purs @@ -0,0 +1,110 @@ +---------------------------------------------------------------------------------------- +-- | SimpleStorage (Automatically generated by purescript-web3-generator and copied over) +----------------------------------------------------------------------------------------- + +module Web3Spec.Live.SimpleStorage where + +import Prelude + +import Data.Either (Either) +import Data.Functor.Tagged (Tagged, tagged, untagged) +import Data.Generic.Rep (class Generic) +import Data.Generic.Rep.Eq (genericEq) +import Data.Generic.Rep.Show (genericShow) +import Data.Lens ((.~)) +import Data.Maybe (Maybe(..), fromJust) +import Data.Newtype (class Newtype) +import Data.Symbol (SProxy) +import Network.Ethereum.Web3 (_address, _topics, call, class EventFilter, deployContract, sendTx) +import Network.Ethereum.Web3.Contract.Internal (uncurryFields) +import Network.Ethereum.Web3.Solidity (D2, D5, D6, DOne, Tuple0(..), Tuple1(..), UIntN, class IndexedEvent, unTuple1) +import Network.Ethereum.Web3.Solidity.Size (type (:&)) +import Network.Ethereum.Web3.Types (CallError, ChainCursor, HexString, NoPay, TransactionOptions, Web3, defaultFilter, mkHexString) +import Partial.Unsafe (unsafePartial, unsafePartialBecause) + +deployBytecode :: HexString +deployBytecode = unsafePartialBecause "This bytecode was copied and pasted from a chanterelle project" $ fromJust $ + mkHexString "6060604052341561000f57600080fd5b7fb94ae47ec9f4248692e2ecf9740b67ab493f3dcc8452bedc7d9cd911c28d1ca5436040518082815260200191505060405180910390a1610107806100556000396000f3006060604052600436106049576000357c0100000000000000000000000000000000000000000000000000000000900463ffffffff16806306661abd14604e578063d14e62b8146074575b600080fd5b3415605857600080fd5b605e6094565b6040518082815260200191505060405180910390f35b3415607e57600080fd5b60926004808035906020019091905050609a565b005b60005481565b806000819055507fa32bc18230dd172221ac5c4821a5f1f1a831f27b1396d244cdd891c58f132435816040518082815260200191505060405180910390a1505600a165627a7a7230582023412a39f8bfbbb1939c02b894f7f224f2dbb2fda0ca79b2084ff59e65fe1f980029" + +-------------------------------------------------------------------------------- +-- | CountFn +-------------------------------------------------------------------------------- + + +type CountFn = Tagged (SProxy "count()") (Tuple0 ) + +count :: forall e. TransactionOptions NoPay -> ChainCursor -> Web3 e (Either CallError (UIntN (D2 :& D5 :& DOne D6))) +count x0 cm = map unTuple1 <$> call x0 cm ((tagged $ Tuple0 ) :: CountFn) + +-------------------------------------------------------------------------------- +-- | SetCountFn +-------------------------------------------------------------------------------- + + +type SetCountFn = Tagged (SProxy "setCount(uint256)") (Tuple1 (UIntN (D2 :& D5 :& DOne D6))) + +setCount :: forall e. TransactionOptions NoPay -> { _count :: (UIntN (D2 :& D5 :& DOne D6)) } -> Web3 e HexString +setCount x0 r = uncurryFields r $ setCount' x0 + where + setCount' :: TransactionOptions NoPay -> Tagged (SProxy "_count") (UIntN (D2 :& D5 :& DOne D6)) -> Web3 e HexString + setCount' y0 y1 = sendTx y0 ((tagged $ Tuple1 (untagged y1 )) :: SetCountFn) + +-------------------------------------------------------------------------------- +-- | ConstructorFn +-------------------------------------------------------------------------------- + + +type ConstructorFn = Tagged (SProxy "constructor()") (Tuple0 ) + +constructor :: forall e. TransactionOptions NoPay -> HexString -> Web3 e HexString +constructor x0 bc = deployContract x0 bc ((tagged $ Tuple0 ) :: ConstructorFn) + +-------------------------------------------------------------------------------- +-- | CountSet +-------------------------------------------------------------------------------- + + +newtype CountSet = CountSet {_count :: (UIntN (D2 :& D5 :& DOne D6))} + +derive instance newtypeCountSet :: Newtype CountSet _ + +instance eventFilterCountSet :: EventFilter CountSet where + eventFilter _ addr = defaultFilter + # _address .~ Just addr + # _topics .~ Just [Just ( unsafePartial $ fromJust $ mkHexString "a32bc18230dd172221ac5c4821a5f1f1a831f27b1396d244cdd891c58f132435")] + +instance indexedEventCountSet :: IndexedEvent (Tuple0 ) (Tuple1 (Tagged (SProxy "_count") (UIntN (D2 :& D5 :& DOne D6)))) CountSet where + isAnonymous _ = false + +derive instance genericCountSet :: Generic CountSet _ + +instance eventGenericCountSetShow :: Show CountSet where + show = genericShow + +instance eventGenericCountSeteq :: Eq CountSet where + eq = genericEq + +-------------------------------------------------------------------------------- +-- | Deployed +-------------------------------------------------------------------------------- + + +newtype Deployed = Deployed {_blockNumber :: (UIntN (D2 :& D5 :& DOne D6))} + +derive instance newtypeDeployed :: Newtype Deployed _ + +instance eventFilterDeployed :: EventFilter Deployed where + eventFilter _ addr = defaultFilter + # _address .~ Just addr + # _topics .~ Just [Just ( unsafePartial $ fromJust $ mkHexString "b94ae47ec9f4248692e2ecf9740b67ab493f3dcc8452bedc7d9cd911c28d1ca5")] + +instance indexedEventDeployed :: IndexedEvent (Tuple0 ) (Tuple1 (Tagged (SProxy "_blockNumber") (UIntN (D2 :& D5 :& DOne D6)))) Deployed where + isAnonymous _ = false + +derive instance genericDeployed :: Generic Deployed _ + +instance eventGenericDeployedShow :: Show Deployed where + show = genericShow + +instance eventGenericDeployedeq :: Eq Deployed where + eq = genericEq