Merge pull request #20 from input-output-hk/abailly-iohk/complete-hea…

…d-protocol

Commit UTxOs and CollectCom aggregates them

hydra-node/src/Hydra/API/Server.hs

@@ -24,7 +24,7 @@ data APIServerLog
   | APIResponseSent {sentResponse :: Text}
   | APIRequestReceived {receivedRequest :: Text}
   | APIInvalidRequest {receivedRequest :: Text}
-  deriving (Show)
+  deriving (Eq, Show)
 
 runAPIServer ::
   Tx tx =>

hydra-node/src/Hydra/Chain/ZeroMQ.hs

@@ -45,7 +45,7 @@ data MockChainLog tx
   | ChainSyncStarted {syncAddress :: String}
   | ReceivedTransaction {transaction :: OnChainTx tx}
   | CatchingUpTransactions {catchupAddress :: String, numberOfTransactions :: Int}
-  deriving (Show)
+  deriving (Eq, Show)
 
 startChain :: Tx tx => String -> String -> String -> Tracer IO (MockChainLog tx) -> IO ()
 startChain chainSyncAddress chainCatchupAddress postTxAddress tracer = do

hydra-node/src/Hydra/HeadLogic.hs

@@ -10,7 +10,6 @@ import Data.List ((\\))
 import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
 import Hydra.Ledger (
-  Amount,
   Committed,
   Ledger,
   ParticipationToken (..),
@@ -21,7 +20,6 @@ import Hydra.Ledger (
   ValidationResult (Invalid, Valid),
   applyTransactions,
   canApply,
-  initUTxO,
  )
 
 data Event tx
@@ -42,11 +40,14 @@ deriving instance Tx tx => Show (Effect tx)
 
 data ClientRequest tx
   = Init [Party]
-  | Commit Amount
+  | Commit (UTxO tx)
   | NewTx tx
   | Close
   | Contest
-  deriving (Eq, Read, Show)
+
+deriving instance Tx tx => Eq (ClientRequest tx)
+deriving instance Tx tx => Show (ClientRequest tx)
+deriving instance Tx tx => Read (ClientRequest tx)
 
 type SnapshotNumber = Natural
 
@@ -90,8 +91,8 @@ data HydraMessage tx
 -- fully recoverable from transactions observed on chain
 data OnChainTx tx
   = InitTx (Set ParticipationToken)
-  | CommitTx ParticipationToken Natural
-  | CollectComTx
+  | CommitTx ParticipationToken (UTxO tx)
+  | CollectComTx (UTxO tx)
   | CloseTx (Snapshot tx) [tx]
   | ContestTx
   | FanoutTx (UTxO tx)
@@ -110,7 +111,7 @@ deriving instance Tx tx => Show (HeadState tx)
 
 data HeadStatus tx
   = InitState
-  | CollectingState PendingCommits Committed
+  | CollectingState PendingCommits (Committed tx)
   | OpenState (SimpleHeadState tx)
   | ClosedState (UTxO tx)
   | FinalState
@@ -193,25 +194,25 @@ update Environment{party, snapshotStrategy} ledger (HeadState p st) ev = case (s
     let parties = Set.map thisToken tokens
      in newState (p{parties}) (CollectingState tokens mempty) [ClientEffect ReadyToCommit]
   --
-  (CollectingState remainingTokens _, ClientEvent (Commit amount)) ->
+  (CollectingState remainingTokens _, ClientEvent (Commit utxo)) ->
     case findToken remainingTokens party of
       Nothing ->
         panic $ "you're not allowed to commit (anymore): remainingTokens : " <> show remainingTokens <> ", partiyIndex:  " <> show party
-      Just pt -> newState p st [OnChainEffect (CommitTx pt amount)]
-  (CollectingState remainingTokens committed, OnChainEvent (CommitTx pt amount)) ->
+      Just pt -> newState p st [OnChainEffect (CommitTx pt utxo)]
+  (CollectingState remainingTokens committed, OnChainEvent (CommitTx pt utxo)) ->
     let remainingTokens' = Set.delete pt remainingTokens
-        newCommitted = Map.insert pt amount committed
+        newCommitted = Map.insert pt utxo committed
         newHeadState = CollectingState remainingTokens' newCommitted
      in if canCollectCom party pt remainingTokens'
-          then newState p newHeadState [OnChainEffect CollectComTx]
+          then newState p newHeadState [OnChainEffect $ CollectComTx $ mconcat $ Map.elems newCommitted]
           else newState p newHeadState []
   (_, OnChainEvent CommitTx{}) ->
     -- TODO: This should warn the user / client that something went _terribly_ wrong
     --       We shouldn't see any commit outside of the collecting state, if we do,
     --       there's an issue our logic or onChain layer.
     newState p st []
-  (_, OnChainEvent CollectComTx) ->
-    let u0 = initUTxO ledger -- TODO(SN): should construct u0 from the collected utxo
+  (_, OnChainEvent (CollectComTx utxo)) ->
+    let u0 = utxo
      in newState
           p
           (OpenState $ SimpleHeadState u0 mempty mempty (Snapshot 0 u0 mempty))

hydra-node/src/Hydra/Ledger.hs

@@ -5,10 +5,7 @@ import Cardano.Prelude hiding (undefined)
 -- NOTE(MB): We probably want to move these common types somewhere else. Putting
 -- here to avoid circular dependencies with Hydra.Logic
 
-type Committed = Map ParticipationToken Amount
-
--- | Naiive representation of value, which is likely to change.
-type Amount = Natural
+type Committed tx = Map ParticipationToken (UTxO tx)
 
 -- | Identifies the commit of a single party member
 data ParticipationToken = ParticipationToken
@@ -29,6 +26,7 @@ class
   , Show (UTxO tx)
   , Read tx
   , Read (UTxO tx)
+  , Monoid (UTxO tx)
   ) =>
   Tx tx
   where

hydra-node/src/Hydra/Ledger/MaryTest.hs

@@ -54,6 +54,13 @@ type MaryTest = MaryEra TestCrypto
 
 type MaryTestTx = Ledger.Tx MaryTest
 
+-- Orphan
+instance Semigroup (Ledger.UTxO MaryTest) where
+  Ledger.UTxO u1 <> Ledger.UTxO u2 = Ledger.UTxO (u1 <> u2)
+
+instance Monoid (Ledger.UTxO MaryTest) where
+  mempty = Ledger.UTxO mempty
+
 instance Tx MaryTestTx where
   type UTxO MaryTestTx = Ledger.UTxO MaryTest
 

hydra-node/src/Hydra/Logging.hs

@@ -5,7 +5,7 @@
 -- iohk-monitoring package, but that might change soon.
 module Hydra.Logging (
   -- * Tracer
-  Tracer,
+  Tracer (..),
   natTracer,
   nullTracer,
   contramap,

hydra-node/src/Hydra/Logging/Messages.hs

@@ -6,7 +6,7 @@
 -- collection.
 module Hydra.Logging.Messages where
 
-import Cardano.Prelude (Show)
+import Cardano.Prelude (Eq, Show)
 import Hydra.API.Server (APIServerLog)
 import Hydra.Chain.ZeroMQ (MockChainLog)
 import Hydra.Node (HydraNodeLog)
@@ -16,4 +16,4 @@ data HydraLog tx net
   | APIServer APIServerLog
   | Network net
   | Node (HydraNodeLog tx)
-  deriving (Show)
+  deriving (Eq, Show)