Handle blockchain events

IntersectMBO · Oct 15, 2020 · c39ef91 · c39ef91
1 parent d1905ac
commit c39ef91
Show file tree

Hide file tree

Showing 3 changed files with 9 additions and 4 deletions.
diff --git a/plutus-contract/src/Language/Plutus/Contract/Trace.hs b/plutus-contract/src/Language/Plutus/Contract/Trace.hs
@@ -70,6 +70,7 @@ module Language.Plutus.Contract.Trace
     , handleBlockchainEvents
     , handleBlockchainEventsOptions
     , handleBlockchainQueries
+    , handleSlotNotifications
     -- * Initial distributions of emulated chains
     , InitialDistribution
     , defaultDist

diff --git a/plutus-contract/src/Plutus/Trace/Emulator/ContractInstance.hs b/plutus-contract/src/Plutus/Trace/Emulator/ContractInstance.hs
@@ -32,6 +32,7 @@ import           Language.Plutus.Contract.Schema               (Event (..), Hand
 import           Language.Plutus.Contract.Trace.RequestHandler (RequestHandler (..), tryHandler, wrapHandler)
 import           Language.Plutus.Contract.Types                (ResumableResult (..))
 import qualified Language.Plutus.Contract.Types                as Contract.Types
+import Language.Plutus.Contract.Trace (handleBlockchainQueries, handleSlotNotifications)
 import           Plutus.Trace.Emulator.Types                   (ContractConstraints, ContractHandle (..),
                                                                 EmulatorAgentThreadEffs, EmulatorEvent (..),
                                                                 EmulatorState, instanceIdThreads)
@@ -109,18 +110,20 @@ runInstance :: forall s e a effs.
 runInstance event = do
     case event of
         Just (EndpointCall vl) -> do
-            -- check if the endpoint is active and throw an error if it isn't
+            -- TODO:
+            -- check if the endpoint is active and (maybe - configurable) throw an error if it isn't
             -- _hks <- getHooks @s @e @a
             e <- case JSON.fromJSON @(Event s) vl of
                     JSON.Error e'       -> throwError $ JSONDecodingError e'
                     JSON.Success event' -> pure event'
-            -- TODO: What to do if endpoint is not active? -> Configurable (wait or error)
+
             void $ respondToRequest @s @e @a $ RequestHandler $ \h -> do
                 guard $ handlerName h == eventName e
                 pure e
             pure ()
         _ -> do
-            -- TODO: see if we can handle any requests
+            -- FIXME: handleSlotNotifications configurable
+            void $ respondToRequest @s @e @a (handleBlockchainQueries <> handleSlotNotifications)
             mkSysCall @effs @EmulatorEvent Low Suspend >>= runInstance
 
 getHooks :: forall s e a effs. Member (State (ContractInstanceState s e a)) effs => Eff effs [Request (Handlers s)]

diff --git a/plutus-contract/src/Plutus/Trace/Emulator/Types.hs b/plutus-contract/src/Plutus/Trace/Emulator/Types.hs
@@ -37,7 +37,7 @@ import           Data.Map                        (Map)
 import           Data.Proxy                      (Proxy (..))
 import qualified Data.Row.Internal               as V
 import           Data.Void                       (Void)
-import           Language.Plutus.Contract        (type (.\/), BlockchainActions, Contract, Endpoint, HasEndpoint)
+import           Language.Plutus.Contract        (type (.\/), BlockchainActions, Contract, Endpoint, HasEndpoint, HasBlockchainActions)
 import           Language.Plutus.Contract.Schema (Input, Output)
 import           Ledger.Slot                     (Slot)
 import           Ledger.Value                    (Value)
@@ -52,6 +52,7 @@ type ContractConstraints s =
     , V.AllUniqueLabels (Input s)
     , V.Forall (Input s) JSON.FromJSON
     , V.Forall (Input s) JSON.ToJSON
+    , HasBlockchainActions s
     )
 
 data EmulatorEvent =