Change Ledger interface to apply many transactions

Also define 'canApply' in terms of 'applyTransactions'.

hydra-node/src/Hydra/HeadLogic.hs

@@ -12,15 +12,16 @@ import qualified Data.Set as Set
 import Hydra.Ledger (
   Amount,
   Committed,
-  Ledger (applyTransaction, canApply),
+  Ledger,
   ParticipationToken (..),
   Party,
   Tx,
   UTxO,
   ValidationError,
   ValidationResult (Invalid, Valid),
+  applyTransactions,
+  canApply,
   initUTxO,
-  makeUTxO,
  )
 
 data Event tx
@@ -217,7 +218,7 @@ update Environment{party, snapshotStrategy} ledger (HeadState p st) ev = case (s
       Invalid _ -> panic "TODO: wait until it may be applied"
       Valid -> newState p st [NetworkEffect $ AckTx party tx]
   (OpenState headState@SimpleHeadState{confirmedUTxO, confirmedTxs, confirmedSnapshot, unconfirmedTxs}, NetworkEvent (AckTx otherParty tx)) ->
-    case applyTransaction ledger confirmedUTxO tx of
+    case applyTransactions ledger confirmedUTxO [tx] of
       Left err -> panic $ "TODO: validation error: " <> show err
       Right newLedgerState -> do
         let sigs =
@@ -250,7 +251,7 @@ update Environment{party, snapshotStrategy} ledger (HeadState p st) ev = case (s
               )
               []
   (OpenState s@SimpleHeadState{confirmedSnapshot}, NetworkEvent (ReqSn sn txs)) ->
-    case makeUTxO ledger (utxo confirmedSnapshot) txs of
+    case applyTransactions ledger (utxo confirmedSnapshot) txs of
       Left e ->
         panic $ "Received not applicable snapshot (" <> show sn <> ") " <> show txs <> ": " <> show e
       Right u ->

hydra-node/src/Hydra/Ledger.hs

@@ -33,13 +33,13 @@ class
   type UTxO tx
 
 data Ledger tx = Ledger
-  { canApply :: UTxO tx -> tx -> ValidationResult
-  , applyTransaction :: UTxO tx -> tx -> Either ValidationError (UTxO tx)
+  { applyTransactions :: UTxO tx -> [tx] -> Either ValidationError (UTxO tx)
   , initUTxO :: UTxO tx
   }
 
-makeUTxO :: forall tx. Ledger tx -> UTxO tx -> [tx] -> Either ValidationError (UTxO tx)
-makeUTxO Ledger{applyTransaction} = foldM applyTransaction
+canApply :: Ledger tx -> UTxO tx -> tx -> ValidationResult
+canApply ledger utxo tx =
+  either Invalid (const Valid) $ applyTransactions ledger utxo (pure tx)
 
 -- | Either valid or an error which we get from the ledger-specs tx validation.
 data ValidationResult

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

@@ -19,9 +19,10 @@ import Cardano.Slotting.EpochInfo (fixedSizeEpochInfo)
 import Cardano.Slotting.Slot (EpochSize (EpochSize))
 import Data.Default (Default, def)
 import qualified Data.Map as Map
+import qualified Data.Sequence as Seq
 import qualified Data.Sequence.Strict as StrictSeq
 import qualified Data.Set as Set
-import Hydra.Ledger (Ledger (..), Tx (..), ValidationError (..), ValidationResult (..))
+import Hydra.Ledger (Ledger (..), Tx (..), ValidationError (..))
 import Shelley.Spec.Ledger.API (
   Addr,
   ApplyTx,
@@ -58,32 +59,20 @@ instance Tx MaryTestTx where
 cardanoLedger :: Ledger.LedgersEnv MaryTest -> Ledger (Ledger.Tx MaryTest)
 cardanoLedger env =
   Ledger
-    { canApply = validateTx env
-    , applyTransaction = applyTx env
+    { applyTransactions = applyTx env
     , initUTxO = getUTxO def
     }
 
-validateTx ::
-  Default (Ledger.UTxOState era) =>
-  Default (Ledger.LedgerState era) =>
-  ApplyTx era =>
-  Ledger.LedgersEnv era ->
-  Ledger.UTxO era ->
-  Ledger.Tx era ->
-  ValidationResult
-validateTx env utxo tx =
-  either Invalid (const Valid) $ applyTx env utxo tx
-
 applyTx ::
   Default (Ledger.UTxOState era) =>
   Default (Ledger.LedgerState era) =>
   ApplyTx era =>
   Ledger.LedgersEnv era ->
   Ledger.UTxO era ->
-  Ledger.Tx era ->
+  [Ledger.Tx era] ->
   Either ValidationError (Ledger.UTxO era)
-applyTx env utxo tx =
-  case Ledger.applyTxsTransition globals env (pure tx) (fromUTxO utxo) of
+applyTx env utxo txs =
+  case Ledger.applyTxsTransition globals env (Seq.fromList txs) (fromUTxO utxo) of
     Left err -> Left $ toValidationError err
     Right ls -> Right $ getUTxO ls
  where

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

@@ -11,8 +11,15 @@ import Control.Monad (fail)
 import Data.List (nub)
 import Hydra.Ledger
 
--- | Simple mock transaction, which directly encodes validity and thus
--- simplifies the LedgerState to a list of txs
+-- | Simple mock transaction.
+--
+-- NOTE: There's no need to represent a real `tx` and do any fake ledger
+-- validation because we can already represent that via `InvalidTx`.
+--
+-- In the end, we are really interested in the resulting UTxO which
+-- _could_ be constructed from all the valid transactions that have
+-- passed through the head. So it suffices to keep a list of all valid
+-- transactions in the mock.
 data MockTx = ValidTx TxId | InvalidTx
   deriving stock (Eq, Ord, Generic, Read, Show)
 
@@ -36,21 +43,10 @@ instance Tx MockTx where
 mockLedger :: Ledger MockTx
 mockLedger =
   Ledger
-    { canApply = \st tx -> case st `seq` tx of
-        ValidTx _ -> Valid
-        InvalidTx -> Invalid ValidationError
-    , applyTransaction = \txs tx ->
-        -- NOTE:
-        -- There's no need to represent a real `tx` and do any fake ledger
-        -- validation because we can already represent that via `InvalidTx`.
-        --
-        -- In the end, we are really interested in the resulting UTxO which
-        -- _could_ be constructed from all the valid transactions that have
-        -- passed through the head. So it suffices to keep a list of all valid
-        -- transactions in the mock.
+    { applyTransactions = foldM $ \utxo tx ->
         case tx of
           InvalidTx ->
             Left ValidationError
-          ValidTx{} -> Right $ nub (tx : txs)
+          ValidTx{} -> Right $ nub (tx : utxo)
     , initUTxO = mempty
     }

hydra-node/test/Hydra/LedgerSpec.hs

@@ -7,21 +7,20 @@ module Hydra.LedgerSpec where
 
 import Cardano.Prelude
 
-import Hydra.Ledger (ValidationError (..), ValidationResult (..))
+import Hydra.Ledger (ValidationError (..))
 import Hydra.Ledger.MaryTest (
+  applyTx,
   mkLedgerEnv,
   testUTxO,
   txInvalid,
   txSimpleTransfer,
-  validateTx,
  )
-import Test.Hspec (Spec, describe, it, shouldBe)
+import Test.Hspec (Spec, describe, it, shouldBe, shouldSatisfy)
 
 spec :: Spec
 spec = describe "Hydra Ledger (Mary)" $ do
   it "should reject invalid transactions" $ do
-    validateTx mkLedgerEnv testUTxO txInvalid `shouldBe` Invalid ValidationError
+    applyTx mkLedgerEnv testUTxO [txInvalid] `shouldBe` Left ValidationError
 
   it "should validate transactions which simply transfer value" $ do
-    validateTx mkLedgerEnv testUTxO txSimpleTransfer `shouldBe` Valid
-    txSimpleTransfer `shouldBe` txSimpleTransfer
+    applyTx mkLedgerEnv testUTxO [txSimpleTransfer] `shouldSatisfy` isRight