Create EventSource and EventSink handles

hydra-cluster/src/Hydra/Cluster/Scenarios.hs

@@ -557,7 +557,7 @@ threeNodesNoErrorsOnOpen tracer tmpDir node@RunningNode{nodeSocket} hydraScripts
 
   let contestationPeriod = UnsafeContestationPeriod 2
   let hydraTracer = contramap FromHydraNode tracer
-  withHydraCluster hydraTracer tmpDir nodeSocket 0 cardanoKeys hydraKeys hydraScriptsTxId contestationPeriod $ \(leader :| rest) -> do
+  withHydraCluster hydraTracer tmpDir nodeSocket 1 cardanoKeys hydraKeys hydraScriptsTxId contestationPeriod $ \(leader :| rest) -> do
     let clients = leader : rest
     waitForNodesConnected hydraTracer 20 clients
 

hydra-node/hydra-node.cabal

@@ -67,6 +67,8 @@ library
     Hydra.Chain.Offline
     Hydra.ContestationPeriod
     Hydra.Crypto
+    Hydra.Environment
+    Hydra.Events
     Hydra.HeadId
     Hydra.HeadLogic
     Hydra.HeadLogic.Error

hydra-node/src/Hydra/Chain.hs

@@ -27,6 +27,7 @@ import Hydra.Cardano.Api (
   Witness,
  )
 import Hydra.ContestationPeriod (ContestationPeriod)
+import Hydra.Environment (Environment (..))
 import Hydra.HeadId (HeadId, HeadSeed)
 import Hydra.Ledger (ChainSlot, IsTx, UTxOType)
 import Hydra.OnChainId (OnChainId)
@@ -60,6 +61,11 @@ instance Arbitrary HeadParameters where
     dedupParties HeadParameters{contestationPeriod, parties} =
       HeadParameters{contestationPeriod, parties = nub parties}
 
+-- | Make 'HeadParameters' that are consistent with the given 'Environment'.
+mkHeadParameters :: Environment -> HeadParameters
+mkHeadParameters Environment{party, otherParties, contestationPeriod} =
+  HeadParameters{contestationPeriod, parties = party : otherParties}
+
 -- | Data type used to post transactions on chain. It holds everything to
 -- construct corresponding Head protocol transactions.
 data PostChainTx tx

hydra-node/src/Hydra/Environment.hs

@@ -0,0 +1,36 @@
+module Hydra.Environment where
+
+import Hydra.Prelude
+
+import Hydra.ContestationPeriod (ContestationPeriod)
+import Hydra.Crypto (HydraKey, SigningKey)
+import Hydra.OnChainId (OnChainId)
+import Hydra.Party (Party, deriveParty)
+
+data Environment = Environment
+  { party :: Party
+  -- ^ This is the p_i from the paper
+  , -- XXX: In the long run we would not want to keep the signing key in memory,
+    -- i.e. have an 'Effect' for signing or so.
+    signingKey :: SigningKey HydraKey
+  , otherParties :: [Party]
+  , -- XXX: Improve naming
+    participants :: [OnChainId]
+  , contestationPeriod :: ContestationPeriod
+  }
+  deriving stock (Show, Eq)
+
+instance Arbitrary Environment where
+  arbitrary = do
+    signingKey <- arbitrary
+    otherParties <- arbitrary
+    participants <- arbitrary
+    contestationPeriod <- arbitrary
+    pure $
+      Environment
+        { signingKey
+        , party = deriveParty signingKey
+        , otherParties
+        , contestationPeriod
+        , participants
+        }

hydra-node/src/Hydra/Events.hs

@@ -0,0 +1,37 @@
+-- | This module defines the types and functions for creating 'EventSource' and
+-- 'EventSink' instances and is intended to be used as an extension point.
+--
+-- A single 'EventSource' and zero or more 'EventSink' handles are used by the
+-- main 'HydraNode' handle to load and send out events.
+--
+-- TODO: add an example event source sink (on top of the persistence one)
+module Hydra.Events where
+
+import Hydra.Prelude
+
+-- FIXME(Elaine): we have to figure out a better taxonomy/nomenclature for the events/statechange stuff
+-- the eventID here is not the same as the eventID in Queued, that one is more fickle and influenced by non state change events
+-- this one is only incremented when we have a new state change event
+type EventId = Word64
+
+class HasEventId a where
+  getEventId :: a -> EventId
+
+instance HasEventId (EventId, a) where
+  getEventId = fst
+
+newtype EventSource e m = EventSource
+  { getEvents :: HasEventId e => m [e]
+  -- ^ Retrieve all events from the event source.
+  }
+
+newtype EventSink e m = EventSink
+  { putEvent :: HasEventId e => e -> m ()
+  -- ^ Send a single event to the event sink.
+  }
+
+putEventToSinks :: (Monad m, HasEventId e) => [EventSink e m] -> e -> m ()
+putEventToSinks sinks e = forM_ sinks $ \sink -> putEvent sink e
+
+putEventsToSinks :: (Monad m, HasEventId e) => [EventSink e m] -> [e] -> m ()
+putEventsToSinks sinks = mapM_ (putEventToSinks sinks)