Use Party instead of faked ParticipationToken

Also refactor some properties in the 'update' function to be properly
worded now

hydra-node/src/Hydra/HeadLogic.hs

@@ -12,7 +12,6 @@ import qualified Data.Set as Set
 import Hydra.Ledger (
   Committed,
   Ledger,
-  ParticipationToken (..),
   Party,
   Tx,
   UTxO,
@@ -90,8 +89,8 @@ data HydraMessage tx
 -- transactions could be parameterized using such data types, but they are not
 -- fully recoverable from transactions observed on chain
 data OnChainTx tx
-  = InitTx (Set ParticipationToken)
-  | CommitTx ParticipationToken (UTxO tx)
+  = InitTx (Set Party)
+  | CommitTx Party (UTxO tx)
   | CollectComTx (UTxO tx)
   | CloseTx (Snapshot tx) [tx]
   | ContestTx (Snapshot tx) [tx]
@@ -131,7 +130,7 @@ data SimpleHeadState tx = SimpleHeadState
 deriving instance Tx tx => Eq (SimpleHeadState tx)
 deriving instance Tx tx => Show (SimpleHeadState tx)
 
-type PendingCommits = Set ParticipationToken
+type PendingCommits = Set Party
 
 -- | Contains at least the contestation period and other things.
 data HeadParameters = HeadParameters
@@ -188,25 +187,27 @@ update ::
   Outcome tx
 update Environment{party, snapshotStrategy} ledger (HeadState p st) ev = case (st, ev) of
   (InitState, ClientEvent (Init parties)) ->
-    newState p InitState [OnChainEffect (InitTx $ makeAllTokens parties)]
-  (_, OnChainEvent (InitTx tokens)) ->
+    newState p InitState [OnChainEffect (InitTx $ Set.fromList parties)]
+  (_, OnChainEvent (InitTx parties)) ->
     -- NOTE(SN): Eventually we won't be able to construct 'HeadParameters' from
     -- the 'InitTx'
-    let parties = Set.map thisToken tokens
-     in newState (p{parties}) (CollectingState tokens mempty) [ClientEffect ReadyToCommit]
+    newState (p{parties}) (CollectingState parties mempty) [ClientEffect ReadyToCommit]
   --
-  (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 utxo)]
-  (CollectingState remainingTokens committed, OnChainEvent (CommitTx pt utxo)) ->
-    let remainingTokens' = Set.delete pt remainingTokens
-        newCommitted = Map.insert pt utxo committed
-        newHeadState = CollectingState remainingTokens' newCommitted
-     in if canCollectCom party pt remainingTokens'
-          then newState p newHeadState [OnChainEffect $ CollectComTx $ mconcat $ Map.elems newCommitted]
-          else newState p newHeadState []
+  (CollectingState remainingParties _, ClientEvent (Commit utxo)) ->
+    if canCommit
+      then newState p st [OnChainEffect (CommitTx party utxo)]
+      else panic $ "you're not allowed to commit (anymore): remainingParties : " <> show remainingParties <> ", partiyIndex:  " <> show party
+   where
+    canCommit = party `elem` remainingParties
+  (CollectingState remainingParties committed, OnChainEvent (CommitTx pt utxo)) ->
+    if canCollectCom
+      then newState p newHeadState [OnChainEffect $ CollectComTx $ mconcat $ Map.elems newCommitted]
+      else newState p newHeadState []
+   where
+    remainingParties' = Set.delete pt remainingParties
+    newCommitted = Map.insert pt utxo committed
+    newHeadState = CollectingState remainingParties' newCommitted
+    canCollectCom = null remainingParties' && pt == party
   (_, 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,
@@ -346,15 +347,3 @@ update Environment{party, snapshotStrategy} ledger (HeadState p st) ev = case (s
   (_, NetworkEvent (Ping pty)) ->
     newState p st [ClientEffect $ PeerConnected pty]
   _ -> panic $ "UNHANDLED EVENT: on " <> show party <> " of event " <> show ev <> " in state " <> show st
-
-canCollectCom :: Party -> ParticipationToken -> Set ParticipationToken -> Bool
-canCollectCom party pt remainingTokens = null remainingTokens && thisToken pt == party
-
-makeAllTokens :: [Party] -> Set ParticipationToken
-makeAllTokens parties = Set.fromList $ map (ParticipationToken total) parties
- where
-  total = fromIntegral $ length parties
-
-findToken :: Set ParticipationToken -> Party -> Maybe ParticipationToken
-findToken allTokens party =
-  find (\t -> thisToken t == party) allTokens

hydra-node/src/Hydra/Ledger.hs

@@ -5,18 +5,11 @@ 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 tx = Map ParticipationToken (UTxO tx)
-
--- | Identifies the commit of a single party member
-data ParticipationToken = ParticipationToken
-  { totalTokens :: Natural
-  , thisToken :: Party
-  }
-  deriving (Eq, Ord, Show, Read)
-
 -- | Identifies a party in a Hydra head.
 type Party = Natural
 
+type Committed tx = Map Party (UTxO tx)
+
 -- * Ledger interface
 
 class

hydra-node/test/Hydra/Chain/ZeroMQSpec.hs

@@ -7,7 +7,6 @@ import qualified Data.Set as Set
 import Data.String (String)
 import Hydra.Chain.ZeroMQ (catchUpTransactions, mockChainClient, runChainSync, startChain)
 import Hydra.HeadLogic (OnChainTx (InitTx))
-import Hydra.Ledger (ParticipationToken (..))
 import Hydra.Ledger.Mock (MockTx)
 import Hydra.Logging (nullTracer)
 import System.Timeout (timeout)
@@ -17,7 +16,7 @@ import Test.Util (shouldReturn)
 spec :: Spec
 spec =
   describe "Mock 0MQ-Based Chain" $ do
-    let tx = InitTx (Set.fromList [ParticipationToken 2 1, ParticipationToken 2 2])
+    let tx = InitTx (Set.fromList [1, 2])
         numberOfTxs :: Int
         numberOfTxs = 3
 

hydra-node/test/Hydra/HeadLogicSpec.hs

@@ -2,7 +2,20 @@
 
 module Hydra.HeadLogicSpec where
 
-import Cardano.Prelude
+import Cardano.Prelude (
+  Applicative (pure),
+  Bool (False, True),
+  Foldable (elem),
+  IO,
+  Maybe (..),
+  Monoid (mempty),
+  Ord,
+  Semigroup ((<>)),
+  Set,
+  otherwise,
+  show,
+  ($),
+ )
 
 import Control.Monad.Fail (
   fail,
@@ -24,7 +37,7 @@ import Hydra.HeadLogic (
   SnapshotStrategy (..),
   update,
  )
-import Hydra.Ledger (Ledger (..), ParticipationToken (..), Party, Tx)
+import Hydra.Ledger (Ledger (..), Party, Tx)
 import Hydra.Ledger.Mock (MockTx (ValidTx), mockLedger)
 import Test.Hspec (
   Spec,
@@ -87,7 +100,7 @@ genOnChainTx :: Gen (OnChainTx MockTx)
 genOnChainTx =
   elements
     [ InitTx mempty
-    , CommitTx (ParticipationToken 1 1) [ValidTx 10]
+    , CommitTx 1 [ValidTx 10]
     , CollectComTx []
     , CloseTx (Snapshot 0 mempty mempty) mempty
     , ContestTx (Snapshot 0 mempty mempty) mempty

hydra-plutus/src/Hydra/Contract/OffChain.hs

@@ -96,7 +96,7 @@ init params@HeadParameters{participants, policy, policyId} = do
     mconcat
       [ foldMap
           ( \vk ->
-              let participationToken = OnChain.mkParticipationToken policyId vk
+              let participationToken = OnChain.mkParty policyId vk
                in mconcat
                     [ mustPayToOtherScript
                         (Scripts.scriptHash $ initialScriptInstance params)
@@ -150,7 +150,7 @@ commit params@HeadParameters{policy, policyId} = do
       }
 
   constraints vk (ref, txOut) initial =
-    let amount = txOutValue (txOutTxOut txOut) <> OnChain.mkParticipationToken policyId vk
+    let amount = txOutValue (txOutTxOut txOut) <> OnChain.mkParty policyId vk
      in mconcat
           [ mustBeSignedBy vk
           , -- NOTE: using a 'foldMap' here but that 'initial' utxo really has only one
@@ -223,7 +223,7 @@ collectCom params@HeadParameters{participants, policy, policyId} = do
               (Map.keys stateMachine)
           , foldMap
               (\(_, ref) -> mustSpendScriptOutput ref $ asRedeemer @(RedeemerType OnChain.Commit) ())
-              (zipOnParticipationToken policyId participants commits)
+              (zipOnParty policyId participants commits)
           , foldMap
               (mustIncludeDatum . asDatum @(DatumType OnChain.Commit))
               storedOutputs
@@ -272,15 +272,15 @@ abort params@HeadParameters{participants, policy, policyId} = do
       [ mustBeSignedBy headMember
       , mustPayToTheScript OnChain.Final (lovelaceValueOf 0)
       , foldMap
-          (\vk -> mustForgeCurrency policyId (OnChain.mkParticipationTokenName vk) (-1))
+          (\vk -> mustForgeCurrency policyId (OnChain.mkPartyName vk) (-1))
           participants
       , foldMap mustRefund toRefund
       , foldMap
           (\(_vk, ref) -> mustSpendScriptOutput ref $ asRedeemer @(RedeemerType OnChain.Initial) ref)
-          (zipOnParticipationToken policyId participants initial)
+          (zipOnParty policyId participants initial)
       , foldMap
           (\(_vk, ref) -> mustSpendScriptOutput ref $ asRedeemer @(RedeemerType OnChain.Commit) ())
-          (zipOnParticipationToken policyId participants commits)
+          (zipOnParty policyId participants commits)
       , foldMap
           (`mustSpendScriptOutput` asRedeemer @(RedeemerType OnChain.Hydra) OnChain.Abort)
           (Map.keys stateMachine)
@@ -379,23 +379,23 @@ utxoAtWithDatum addr datum = do
 --
 -- Instead, we must associate each commited utxo to their key using the
 -- participation token that they all carry.
-zipOnParticipationToken ::
+zipOnParty ::
   MonetaryPolicyHash ->
   [PubKeyHash] ->
   UtxoMap ->
   [(PubKeyHash, TxOutRef)]
-zipOnParticipationToken policyId vks utxo =
+zipOnParty policyId vks utxo =
   go [] (flattenUtxo utxo) vks []
  where
   go acc [] _ _ = acc
   go acc _ [] _ = acc
   go acc (u : qu) (vk : qv) qv' =
-    if u `hasParticipationToken` vk
+    if u `hasParty` vk
       then go ((vk, fst u) : acc) qu (qv ++ qv') []
       else go acc (u : qu) qv (vk : qv')
 
-  hasParticipationToken :: (TxOutRef, TxOut) -> PubKeyHash -> Bool
-  hasParticipationToken (_, txOut) vk =
+  hasParty :: (TxOutRef, TxOut) -> PubKeyHash -> Bool
+  hasParty (_, txOut) vk =
     let currency = Value.mpsSymbol policyId
-        token = OnChain.mkParticipationTokenName vk
+        token = OnChain.mkPartyName vk
      in Value.valueOf (txOutValue txOut) currency token > 0

hydra-plutus/src/Hydra/Contract/OnChain.hs

@@ -82,7 +82,7 @@ hydraValidator HeadParameters{participants, policyId} s i ctx =
   case (s, i) of
     (Initial, CollectCom) ->
       let collectComUtxos =
-            snd <$> filterInputs (hasParticipationToken policyId) ctx
+            snd <$> filterInputs (hasParty policyId) ctx
           committedOutputs =
             mapMaybe decodeCommit collectComUtxos
           newState =
@@ -91,7 +91,7 @@ hydraValidator HeadParameters{participants, policyId} s i ctx =
             foldMap txOutValue collectComUtxos
        in and
             [ mustBeSignedByOneOf participants ctx
-            , all (mustForwardParticipationToken ctx policyId) participants
+            , all (mustForwardParty ctx policyId) participants
             , checkScriptContext @(RedeemerType Hydra) @(DatumType Hydra)
                 (mustPayToTheScript newState amountPaid)
                 ctx
@@ -103,7 +103,7 @@ hydraValidator HeadParameters{participants, policyId} s i ctx =
             lovelaceValueOf 0
        in and
             [ mustBeSignedByOneOf participants ctx
-            , all (mustBurnParticipationToken ctx policyId) participants
+            , all (mustBurnParty ctx policyId) participants
             , checkScriptContext @(RedeemerType Hydra) @(DatumType Hydra)
                 (mustPayToTheScript newState amountPaid)
                 ctx
@@ -167,7 +167,7 @@ initialValidator HeadParameters{policyId} hydraScript commitScript vk ref ctx =
         False
       Just utxo ->
         let commitDatum = asDatum @(DatumType Commit) (snd utxo)
-            commitValue = txOutValue (snd utxo) <> mkParticipationToken policyId vk
+            commitValue = txOutValue (snd utxo) <> mkParty policyId vk
          in checkScriptContext @(RedeemerType Initial) @(DatumType Initial)
               ( mconcat
                   [ mustBeSignedBy vk
@@ -364,52 +364,52 @@ mustRunContract script redeemer ctx =
         ctx
 {-# INLINEABLE mustRunContract #-}
 
-mustForwardParticipationToken ::
+mustForwardParty ::
   ScriptContext ->
   MonetaryPolicyHash ->
   PubKeyHash ->
   Bool
-mustForwardParticipationToken ctx policyId vk =
-  let participationToken = mkParticipationToken policyId vk
+mustForwardParty ctx policyId vk =
+  let participationToken = mkParty policyId vk
    in checkScriptContext @() @()
         ( mconcat
             [ mustSpendAtLeast participationToken
             , mustProduceAtLeast participationToken
             ]
         )
         ctx
-{-# INLINEABLE mustForwardParticipationToken #-}
+{-# INLINEABLE mustForwardParty #-}
 
-mustBurnParticipationToken ::
+mustBurnParty ::
   ScriptContext ->
   MonetaryPolicyHash ->
   PubKeyHash ->
   Bool
-mustBurnParticipationToken ctx policyId vk =
-  let assetName = mkParticipationTokenName vk
+mustBurnParty ctx policyId vk =
+  let assetName = mkPartyName vk
    in checkScriptContext @() @() (mustForgeCurrency policyId assetName (-1)) ctx
-{-# INLINEABLE mustBurnParticipationToken #-}
+{-# INLINEABLE mustBurnParty #-}
 
-mkParticipationToken ::
+mkParty ::
   MonetaryPolicyHash ->
   PubKeyHash ->
   Value
-mkParticipationToken policyId vk =
-  Value.singleton (Value.mpsSymbol policyId) (mkParticipationTokenName vk) 1
-{-# INLINEABLE mkParticipationToken #-}
+mkParty policyId vk =
+  Value.singleton (Value.mpsSymbol policyId) (mkPartyName vk) 1
+{-# INLINEABLE mkParty #-}
 
-mkParticipationTokenName ::
+mkPartyName ::
   PubKeyHash ->
   TokenName
-mkParticipationTokenName =
+mkPartyName =
   TokenName . getPubKeyHash
-{-# INLINEABLE mkParticipationTokenName #-}
+{-# INLINEABLE mkPartyName #-}
 
-hasParticipationToken :: MonetaryPolicyHash -> TxInInfo -> Bool
-hasParticipationToken policyId input =
+hasParty :: MonetaryPolicyHash -> TxInInfo -> Bool
+hasParty policyId input =
   let currency = Value.mpsSymbol policyId
    in currency `elem` symbols (txOutValue $ txInInfoResolved input)
-{-# INLINEABLE hasParticipationToken #-}
+{-# INLINEABLE hasParty #-}
 
 filterInputs :: (TxInInfo -> Bool) -> ScriptContext -> [(TxOutRef, TxOut)]
 filterInputs predicate =