Add test

plutus-contract/src/Language/Plutus/Contract.hs

@@ -57,7 +57,7 @@ module Language.Plutus.Contract(
     , ownInstanceId
     -- * Notifications
     , notifyInstance
-    , notify
+    , tell
     -- * Transactions
     , HasWriteTx
     , WriteTx
@@ -113,6 +113,7 @@ import           Language.Plutus.Contract.Types                    (AsCheckpoint
                                                                     throwError)
 
 import qualified Control.Monad.Freer.Extras.Log                    as L
+import qualified Control.Monad.Freer.Writer                        as W
 import           Prelude                                           hiding (until)
 import           Wallet.API                                        (WalletAPIError)
 
@@ -161,7 +162,7 @@ logWarn = Contract . L.logWarn . toJSON
 logError :: ToJSON a => a -> Contract w s e ()
 logError = Contract . L.logError . toJSON
 
--- | Send a notification to the outside world. (This is a placeholder
---   until we implement https://jira.iohk.io/browse/SCP-1837)
-notify :: ToJSON a => a -> Contract w s e ()
-notify = logInfo
+-- | Update the contract's accumulating state @w@
+tell :: w -> Contract w s e ()
+tell = Contract . W.tell
+

plutus-contract/src/Language/Plutus/Contract/Test.hs

@@ -38,6 +38,7 @@ module Language.Plutus.Contract.Test(
     , assertUserLog
     , assertBlockchain
     , assertChainEvents
+    , assertAccumState
     , tx
     , anyTx
     , assertEvents
@@ -556,3 +557,28 @@ assertUserLog pred' = flip postMapM (L.generalize Folds.userLog) $ \lg -> do
     let result = pred' lg
     unless result (tell @(Doc Void) $ vsep ("User log failed to validate:" : fmap pretty lg))
     pure result
+
+-- | Make an assertion about the accumulated state @w@ of
+--   a contract instance.
+assertAccumState ::
+    forall w s e a.
+    ( ContractConstraints s
+    , Monoid w
+    , Show w
+    )
+    => Contract w s e a
+    -> ContractInstanceTag
+    -> (w -> Bool)
+    -> String
+    -> TracePredicate
+assertAccumState contract inst p nm =
+    flip postMapM (Folds.instanceAccumState contract inst) $ \w -> do
+        let result = p w
+        unless result $ do
+            tell @(Doc Void) $ vsep
+                [ "Accumulated state of of" <+> pretty inst <> colon
+                , indent 2 (viaShow w)
+                , "Failed" <+> squotes (fromString nm)
+                ]
+        pure result
+

plutus-contract/src/Wallet/Emulator/Folds.hs

@@ -23,6 +23,7 @@ module Wallet.Emulator.Folds (
     , instanceTransactions
     , Outcome(..)
     , instanceLog
+    , instanceAccumState
     -- * Folds for transactions and the UTXO set
     , chainEvents
     , failedTransactions
@@ -168,6 +169,18 @@ instanceResponses ::
     -> EmulatorEventFoldM effs [Response (Event s)]
 instanceResponses con = fmap (fromMaybe [] . fmap (toList . instEvents)) . instanceState con
 
+-- | Accumulated state of the contract instance
+instanceAccumState ::
+    forall w s e a effs.
+    ( ContractConstraints s
+    , Member (Error EmulatorFoldErr) effs
+    , Monoid w
+    )
+    => Contract w s e a
+    -> ContractInstanceTag
+    -> EmulatorEventFoldM effs w
+instanceAccumState con = fmap (maybe mempty (_observableState . instContractState)) . instanceState con
+
 -- | The log messages produced by the contract instance.
 instanceLog :: ContractInstanceTag -> EmulatorEventFold [EmulatorTimeEvent ContractInstanceLog]
 instanceLog tag =

plutus-use-cases/src/Language/PlutusTx/Coordination/Contracts/Auction.hs

@@ -15,12 +15,14 @@ module Language.PlutusTx.Coordination.Contracts.Auction(
     BuyerSchema,
     SellerSchema,
     AuctionParams(..),
+    HighestBid(..),
     auctionBuyer,
     auctionSeller,
     ) where
 
 
 import           Data.Aeson                            (FromJSON, ToJSON)
+import           Data.Semigroup                        (Last (..))
 import           GHC.Generics                          (Generic)
 import           Language.Plutus.Contract
 import           Language.Plutus.Contract.StateMachine (State (..), StateMachine (..), StateMachineClient,
@@ -66,7 +68,7 @@ PlutusTx.unstableMakeIsData ''HighestBid
 data AuctionState
     = Ongoing HighestBid -- Bids can be submitted.
     | Finished HighestBid -- The auction is finished
-    deriving stock (Generic, Haskell.Show)
+    deriving stock (Generic, Haskell.Show, Haskell.Eq)
     deriving anyclass (ToJSON, FromJSON)
 
 -- | Initial 'AuctionState'. In the beginning the highest bid is 0 and the
@@ -164,7 +166,7 @@ data AuctionLog =
 
 
 -- | Client code for the seller
-auctionSeller :: Value -> Slot -> Contract () SellerSchema SM.SMContractError ()
+auctionSeller :: Value -> Slot -> Contract (Maybe (Last AuctionState)) SellerSchema SM.SMContractError ()
 auctionSeller value slot = do
     self <- Ledger.pubKeyHash <$> ownPubKey
     let params       = AuctionParams{apOwner = self, apAsset = value, apEndTime = slot }
@@ -186,10 +188,10 @@ auctionSeller value slot = do
 
 
 -- | Get the current state of the contract and log it.
-currentState :: StateMachineClient AuctionState AuctionInput -> Contract () BuyerSchema SM.SMContractError (Maybe HighestBid)
+currentState :: StateMachineClient AuctionState AuctionInput -> Contract (Maybe (Last AuctionState)) BuyerSchema SM.SMContractError (Maybe HighestBid)
 currentState client = SM.getOnChainState client >>= \case
     Just ((TypedScriptTxOut{tyTxOutData=Ongoing s}, _), _) -> do
-        notify (Ongoing s)
+        tell (Just $ Last $ Ongoing s)
         pure (Just s)
     _ -> do
         logWarn CurrentStateNotFound
@@ -207,7 +209,7 @@ To achieve this, we have a loop where we wait for one of several events to
 happen and then deal with the event. The waiting is implemented in
 @waitForChange@ and the event handling is in @handleEvent@.
 
-Updates to the user are provided via 'notify'.
+Updates to the user are provided via 'tell'.
 
 -}
 
@@ -217,7 +219,7 @@ data BuyerEvent =
         | OtherBid HighestBid -- ^ Another buyer submitted a higher bid
         | NoChange HighestBid -- ^ Nothing has changed
 
-waitForChange :: AuctionParams -> StateMachineClient AuctionState AuctionInput -> HighestBid -> Contract () BuyerSchema SM.SMContractError BuyerEvent
+waitForChange :: AuctionParams -> StateMachineClient AuctionState AuctionInput -> HighestBid -> Contract (Maybe (Last AuctionState)) BuyerSchema SM.SMContractError BuyerEvent
 waitForChange AuctionParams{apEndTime} client lastHighestBid = do
     s <- currentSlot
     let
@@ -237,13 +239,13 @@ waitForChange AuctionParams{apEndTime} client lastHighestBid = do
     -- see note [Buyer client]
     auctionOver `select` submitOwnBid `select` otherBid
 
-handleEvent :: StateMachineClient AuctionState AuctionInput -> HighestBid -> BuyerEvent -> Contract () BuyerSchema SM.SMContractError (Either HighestBid ())
+handleEvent :: StateMachineClient AuctionState AuctionInput -> HighestBid -> BuyerEvent -> Contract (Maybe (Last AuctionState)) BuyerSchema SM.SMContractError (Either HighestBid ())
 handleEvent client lastHighestBid change =
     let continue = pure . Left
         stop     = pure (Right ())
     -- see note [Buyer client]
     in case change of
-        AuctionIsOver s -> notify (Finished s) >> stop
+        AuctionIsOver s -> tell (Just $ Last $ Finished s) >> stop
         SubmitOwnBid ada -> do
             self <- Ledger.pubKeyHash <$> ownPubKey
             r <- SM.runStep client Bid{newBid = ada, newBidder = self}
@@ -255,11 +257,11 @@ handleEvent client lastHighestBid change =
                 -- but you never know :-)
                 SM.TransitionSuccess (Finished newHighestBid) -> logError (AuctionEnded newHighestBid) >> stop
         OtherBid s -> do
-            notify (Ongoing s)
+            tell (Just $ Last $ Ongoing s)
             continue s
         NoChange s -> continue s
 
-auctionBuyer :: AuctionParams -> Contract () BuyerSchema SM.SMContractError ()
+auctionBuyer :: AuctionParams -> Contract (Maybe (Last AuctionState)) BuyerSchema SM.SMContractError ()
 auctionBuyer params = do
     let inst         = scriptInstance params
         client       = machineClient inst params

plutus-use-cases/test/Spec/Auction.hs

@@ -5,6 +5,7 @@ module Spec.Auction(tests, auctionTrace1, auctionTrace2) where
 
 import           Control.Lens
 import           Control.Monad                                    (void)
+import           Data.Semigroup                                   (Last (..))
 
 import           Language.Plutus.Contract
 import           Language.Plutus.Contract.Test
@@ -25,13 +26,15 @@ tests =
         [ checkPredicateOptions options "run an auction"
             (assertDone seller (Trace.walletInstanceTag w1) (const True) "seller should be done"
             .&&. assertDone buyer (Trace.walletInstanceTag w2) (const True) "buyer should be done"
+            .&&. assertAccumState buyer (Trace.walletInstanceTag w2) ((==) (Just $ Last trace1FinalState)) "final state should be OK"
             .&&. walletFundsChange w1 (Ada.toValue trace1WinningBid <> inv theToken)
             .&&. walletFundsChange w2 (inv (Ada.toValue trace1WinningBid) <> theToken))
             auctionTrace1
         , checkPredicateOptions options "run an auction with multiple bids"
             (assertDone seller (Trace.walletInstanceTag w1) (const True) "seller should be done"
             .&&. assertDone buyer (Trace.walletInstanceTag w2) (const True) "buyer should be done"
             .&&. assertDone buyer (Trace.walletInstanceTag w3) (const True) "3rd party should be done"
+            .&&. assertAccumState buyer (Trace.walletInstanceTag w2) ((==) (Just $ Last trace2FinalState)) "final state should be OK"
             .&&. walletFundsChange w1 (Ada.toValue trace2WinningBid <> inv theToken)
             .&&. walletFundsChange w2 (inv (Ada.toValue trace2WinningBid) <> theToken)
             .&&. walletFundsChange w3 mempty)
@@ -61,10 +64,10 @@ options =
     let initialDistribution = defaultDist & over (at (Wallet 1) . _Just) ((<>) theToken)
     in defaultCheckOptions & emulatorConfig . Trace.initialChainState .~ Left initialDistribution
 
-seller :: Contract () SellerSchema SM.SMContractError ()
+seller :: Contract (Maybe (Last AuctionState)) SellerSchema SM.SMContractError ()
 seller = auctionSeller (apAsset params) (apEndTime params)
 
-buyer :: Contract () BuyerSchema SM.SMContractError ()
+buyer :: Contract (Maybe (Last AuctionState)) BuyerSchema SM.SMContractError ()
 buyer = auctionBuyer params
 
 w1, w2, w3 :: Wallet
@@ -81,7 +84,7 @@ auctionTrace1 = do
     _ <- Trace.waitNSlots 1
     hdl2 <- Trace.activateContractWallet w2 buyer
     _ <- Trace.waitNSlots 1
-    Trace.callEndpoint @"bid" hdl2 50
+    Trace.callEndpoint @"bid" hdl2 trace1WinningBid
     void $ Trace.waitUntilSlot (succ $ succ $ apEndTime params)
 
 trace2WinningBid :: Ada
@@ -98,5 +101,21 @@ auctionTrace2 = do
     _ <- Trace.waitNSlots 15
     Trace.callEndpoint @"bid" hdl3 60
     _ <- Trace.waitNSlots 35
-    Trace.callEndpoint @"bid" hdl2 70
+    Trace.callEndpoint @"bid" hdl2 trace2WinningBid
     void $ Trace.waitUntilSlot (succ $ succ $ apEndTime params)
+
+trace1FinalState :: AuctionState
+trace1FinalState =
+    Finished $
+        HighestBid
+            { highestBid = trace1WinningBid
+            , highestBidder = pubKeyHash (walletPubKey w2)
+            }
+
+trace2FinalState :: AuctionState
+trace2FinalState =
+    Finished $
+        HighestBid
+            { highestBid = trace2WinningBid
+            , highestBidder = pubKeyHash (walletPubKey w2)
+            }