takeEvents

example/contracts/SimplePaidStorage.sol

@@ -10,6 +10,7 @@ contract SimplePaidStorage {
     uint public count = 0;
 
     event CountUpdated(uint newCount);
+    event TokensWithdrawn(uint amount);
 
     constructor(address tokenAddress) {
         _token = IERC20(tokenAddress);
@@ -40,5 +41,6 @@ contract SimplePaidStorage {
     // In case the owner wants to withdraw tokens
     function withdrawTokens(uint amount) external onlyOwner {
         _token.transfer(_owner, amount);
+        emit TokensWithdrawn(amount);
     }
 }

example/test/SimplePaidStorageSpec.purs

@@ -2,7 +2,7 @@ module Test.SimplePaidStorageSpec where
 
 import Prelude
 
-import Chanterelle.Test (assertWeb3, takeEvent)
+import Chanterelle.Test (assertWeb3, takeEvent, takeEvents)
 import Contract.SimplePaidStorage as SPS
 import Contract.Token as Token
 import Control.Monad.Except (ExceptT(..), runExceptT)
@@ -12,7 +12,7 @@ import Data.Either (Either(..))
 import Data.Lens ((?~))
 import Data.Tuple (Tuple(..))
 import Effect.Aff (Aff)
-import Network.Ethereum.Web3 (Address, ChainCursor(..), Web3Error, _from, _to, defaultTransactionOptions, fromInt, runWeb3, unUIntN)
+import Network.Ethereum.Web3 (Address, ChainCursor(..), Web3Error, _from, _to, defaultTransactionOptions, eventFilter, fromInt, runWeb3, unUIntN)
 import Partial.Unsafe (unsafeCrashWith)
 import Test.Common (DeploySpecConfig, unsafeToUInt)
 import Test.Spec (SpecT, beforeAll_, describe, it)
@@ -85,13 +85,18 @@ spec testCfg =
             in
               SPS.withdrawTokens txOpts { amount: contractBalance }
         -- withdraw tokens and wait for event confirmation
-        (Tuple _ e) <- assertWeb3 testCfg.provider $
-          takeEvent (Proxy @Token.Transfer) testCfg.token fetchTokens
-        let Token.Transfer { from, to, value } = e
+        { withdrawn, transfer } <- assertWeb3 testCfg.provider $
+          takeEvents fetchTokens
+            { withdrawn: eventFilter (Proxy @SPS.TokensWithdrawn) testCfg.simplePaidStorage
+            , transfer: eventFilter (Proxy @Token.Transfer) testCfg.token
+            }
+        let Token.Transfer { from, to, value } = transfer
+        let SPS.TokensWithdrawn { amount } = withdrawn
         -- check that the transfer passes the sanity check
         from `shouldEqual` testCfg.simplePaidStorage
         to `shouldEqual` testCfg.simplePaidStorageOwner
         value `shouldEqual` contractBalance
+        amount `shouldEqual` value
         -- check that tokens are not created or destroyed
         { contractBalance: newContractBalance, ownerBalance: newOwnerBalance } <- fetchBalances
         unUIntN newContractBalance `shouldEqual` zero

spago.dhall

@@ -43,6 +43,7 @@ You can edit this file as you like.
   , "prelude"
   , "profunctor-lenses"
   , "record"
+  , "record-extra"
   , "refs"
   , "solc"
   , "strings"

src/Chanterelle/Test.purs

@@ -1,5 +1,10 @@
 module Chanterelle.Test
   ( takeEvent
+  , takeEvents
+  , class TakeEvents
+  , takeEventsBuilder
+  , class JoinEvents
+  , joinEventsBuilder
   , assertWeb3
   , TestConfig
   , TestConfigR
@@ -15,47 +20,135 @@ import Control.Monad.Error.Class (throwError)
 import Control.Monad.Except (runExceptT)
 import Control.Monad.Reader (ask)
 import Data.Either (Either(..), either)
+import Data.Symbol (class IsSymbol)
 import Data.Tuple (Tuple(..))
-import Effect.Aff (Aff)
+import Effect.Aff (Aff, Fiber, error, joinFiber)
+import Effect.Aff.AVar (AVar)
 import Effect.Aff.AVar as AVar
 import Effect.Aff.Class (liftAff)
 import Effect.Class (liftEffect)
 import Effect.Exception (throw)
-import Network.Ethereum.Web3 (class EventFilter, Address, Change(..), EventAction(..), HexString, Provider, Web3, event, eventFilter, forkWeb3', runWeb3)
+import Network.Ethereum.Web3 (class EventFilter, Address, Change(..), EventAction(..), Filter, HexString, Provider, Web3, Web3Error, event, eventFilter, forkWeb3', runWeb3)
 import Network.Ethereum.Web3.Api (eth_getAccounts)
 import Network.Ethereum.Web3.Solidity (class DecodeEvent)
 import Partial.Unsafe (unsafeCrashWith)
 import Prim.Row as Row
-import Record.Builder (build, merge)
-import Type.Proxy (Proxy)
+import Prim.RowList as RL
+import Record as R
+import Record.Builder (Builder, build, merge)
+import Record.Builder as Builder
+import Simple.JSON (writeJSON)
+import Type.Proxy (Proxy(..))
 
 -- | Run a transaction which will dispatch a single event, wait for the event,
 -- | then return the txHash and the event. NB: It will return the first event
 -- | from the given contract caused by the transaction.
 takeEvent
   :: forall ev i ni
    . DecodeEvent i ni ev
-  => Show ev
   => EventFilter ev
   => Proxy ev
   -> Address
   -> Web3 HexString
   -> Web3 (Tuple HexString ev)
-takeEvent prx addrs web3Action = do
-  var <- liftAff AVar.empty
+takeEvent p addr web3Action = do
   txHashVar <- liftAff AVar.empty
-  _ <- forkWeb3' do
-    event (eventFilter prx addrs) $ \e -> do
+  let filter = eventFilter p addr
+  fiber <- hashMonitor txHashVar filter
+  txHash <- web3Action
+  liftAff $ AVar.put txHash txHashVar
+  res <- liftAff $ joinFiber fiber
+  case res of
+    Left e -> throwError (error $ writeJSON e)
+    Right a -> pure (Tuple txHash a)
+
+hashMonitor
+  :: forall ev i ni
+   . DecodeEvent i ni ev
+  => AVar HexString
+  -> Filter ev
+  -> Web3 (Fiber (Either Web3Error ev))
+hashMonitor txHashVar filter = do
+  var <- liftAff AVar.empty
+  let
+    handler = \e -> do
       txHash <- liftAff $ AVar.read txHashVar
       Change { transactionHash } <- ask
       if txHash == transactionHash then do
-        liftAff $ AVar.put e var
+        liftAff (AVar.put e var)
         pure TerminateEvent
       else pure ContinueEvent
-  txHash <- web3Action
+  forkWeb3' (event filter handler *> liftAff (AVar.take var))
+
+takeEvents
+  :: forall row xs row' events
+   . RL.RowToList row xs
+  => TakeEvents xs row () row'
+  => JoinEvents xs row' () events
+  => Web3 HexString
+  -> Record row
+  -> Web3 (Record events)
+takeEvents tx r = do
+  txHashVar <- liftAff $ AVar.empty
+  fibersBuilder <- takeEventsBuilder (Proxy :: _ xs) txHashVar r
+  let fibers = Builder.build fibersBuilder {}
+  txHash <- tx
   liftAff $ AVar.put txHash txHashVar
-  ev <- liftAff $ AVar.take var
-  pure $ Tuple txHash ev
+  eventsBuilder <- liftAff $ joinEventsBuilder (Proxy :: _ xs) fibers
+  pure $ Builder.build eventsBuilder {}
+
+class
+  TakeEvents (xs :: RL.RowList Type) (row :: Row Type) (from :: Row Type) (to :: Row Type)
+  | xs -> row from to where
+  takeEventsBuilder :: Proxy xs -> AVar HexString -> Record row -> Web3 (Builder { | from } { | to })
+
+instance TakeEvents RL.Nil row () () where
+  takeEventsBuilder _ _ _ = pure (identity)
+
+instance
+  ( DecodeEvent i ni ev
+  , IsSymbol name
+  , Row.Cons name (Filter ev) trash row
+  , TakeEvents tail row from from'
+  , Row.Lacks name from'
+  , Row.Cons name (Fiber (Either Web3Error ev)) from' to
+  ) =>
+  TakeEvents (RL.Cons name (Filter ev) tail) row from to where
+  takeEventsBuilder _ txHash r = do
+    let nameP = Proxy :: _ name
+    fiber <- hashMonitor txHash (R.get nameP r :: Filter ev)
+    let first = Builder.insert nameP fiber
+    rest <- takeEventsBuilder (Proxy :: _ tail) txHash r
+    pure (first <<< rest)
+
+class
+  JoinEvents (xs :: RL.RowList Type) (row :: Row Type) (from :: Row Type) (to :: Row Type)
+  | xs -> row from to where
+  joinEventsBuilder :: Proxy xs -> Record row -> Aff (Builder { | from } { | to })
+
+instance JoinEvents RL.Nil row () () where
+  joinEventsBuilder _ _ = pure identity
+
+instance
+  ( DecodeEvent i ni ev
+  , IsSymbol name
+  , Row.Cons name (Fiber (Either Web3Error ev)) trash row
+  , JoinEvents tail row from from'
+  , Row.Lacks name from'
+  , Row.Cons name ev from' to
+  ) =>
+  JoinEvents (RL.Cons name (Filter ev) tail) row from to where
+  joinEventsBuilder _ r = do
+    let
+      nameP = Proxy :: _ name
+      fiber = R.get nameP r :: Fiber (Either Web3Error ev)
+    a <- joinFiber fiber >>= case _ of
+      -- This is a hack and relies on the internals of ps-web3.
+      Left e -> throwError (error $ writeJSON e)
+      Right a -> pure a
+    let first = Builder.insert nameP a
+    rest <- joinEventsBuilder (Proxy :: _ tail) r
+    pure (first <<< rest)
 
 -- | Assert the `Web3` action's result, crash the program if it doesn't succeed.
 assertWeb3