Merge pull request #2592 from input-output-hk/lehins/use-splitmap-for…

…-utxo

Use splitmap for utxo

eras/alonzo/impl/cardano-ledger-alonzo.cabal

@@ -68,6 +68,7 @@ library
     cardano-ledger-shelley-ma,
     cardano-prelude,
     cardano-slotting,
+    compact-map,
     containers,
     data-default,
     deepseq,

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/PlutusScriptApi.hs

@@ -65,6 +65,7 @@ import Cardano.Ledger.TxIn (TxIn (..))
 import Cardano.Slotting.EpochInfo (EpochInfo)
 import Cardano.Slotting.Time (SystemStart)
 import Data.Coders
+import qualified Data.Compact.SplitMap as SplitMap
 import Data.Foldable (foldl')
 import Data.Functor.Identity (Identity, runIdentity)
 import Data.List (intercalate)
@@ -101,7 +102,7 @@ getData tx (UTxO m) sp = case sp of
   Certifying _dcert -> []
   Spending txin ->
     -- Only the Spending ScriptPurpose contains Data
-    case Map.lookup txin m of
+    case SplitMap.lookup txin m of
       Nothing -> []
       Just txout ->
         case getField @"datahash" txout of
@@ -302,7 +303,7 @@ scriptsNeededFromBody (UTxO u) txb = spend ++ reward ++ cert ++ minted
       where
         collect :: TxIn (Crypto era) -> Maybe (ScriptPurpose (Crypto era), ScriptHash (Crypto era))
         collect !i = do
-          addr <- getField @"address" <$> Map.lookup i u
+          addr <- getField @"address" <$> SplitMap.lookup i u
           hash <- getScriptHash addr
           return (Spending i, hash)
 

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxo.hs

@@ -44,6 +44,7 @@ import Cardano.Ledger.BaseTypes
 import Cardano.Ledger.Coin
 import qualified Cardano.Ledger.Core as Core
 import Cardano.Ledger.Credential (Credential (..))
+import qualified Cardano.Ledger.Crypto as CC
 import Cardano.Ledger.Era (Crypto, Era, ValidateScript (..))
 import qualified Cardano.Ledger.Era as Era
 import qualified Cardano.Ledger.Mary.Value as Alonzo (Value)
@@ -68,7 +69,6 @@ import Cardano.Slotting.EpochInfo.API (epochInfoSlotToUTCTime)
 import Cardano.Slotting.Slot (SlotNo)
 import Control.Monad (unless)
 import Control.Monad.Trans.Reader (asks)
-import Control.SetAlgebra (dom, eval, (⊆), (◁), (➖))
 import Control.State.Transition.Extended
 import qualified Data.ByteString.Lazy as BSL (length)
 import Data.Coders
@@ -78,13 +78,15 @@ import Data.Coders
     decode,
     decodeAnnList,
     decodeSet,
+    decodeSplitMap,
     encode,
     encodeFoldable,
     (!>),
     (<!),
     (<*!),
   )
 import Data.Coerce (coerce)
+import qualified Data.Compact.SplitMap as SplitMap
 import Data.Foldable (foldl', toList)
 import Data.Functor.Identity (Identity (..))
 import qualified Data.Map.Strict as Map
@@ -205,6 +207,7 @@ deriving stock instance
 deriving stock instance
   ( Eq (Core.Value era),
     Eq (Core.TxOut era),
+    CC.Crypto (Crypto era),
     Eq (PredicateFailure (Core.EraRule "UTXOS" era))
   ) =>
   Eq (UtxoPredicateFailure era)
@@ -259,11 +262,13 @@ feesOK ::
   Core.Tx era ->
   UTxO era ->
   Rule (AlonzoUTXO era) 'Transition ()
-feesOK pp tx (UTxO m) = do
+feesOK pp tx (UTxO utxo) = do
   let txb = getField @"body" tx
       theFee = getField @"txfee" txb -- Coin supplied to pay fees
       collateral = getField @"collateral" txb -- Inputs allocated to pay theFee
-      utxoCollateral = eval (collateral ◁ m) -- restrict Utxo to those inputs we use to pay fees.
+      -- restrict Utxo to those inputs we use to pay fees.
+      -- (collateral ◁ utxo)
+      utxoCollateral = collateral SplitMap.◁ utxo
       bal = balance @era (UTxO utxoCollateral)
       minimumFee = minfee @era pp tx
       collPerc = getField @"_collateralPercentage" pp
@@ -274,7 +279,7 @@ feesOK pp tx (UTxO m) = do
     -- Part 3
     all vKeyLocked utxoCollateral
       ?! ScriptsNotPaidUTxO
-        (UTxO (Map.filter (not . vKeyLocked) utxoCollateral))
+        (UTxO (SplitMap.filter (not . vKeyLocked) utxoCollateral))
     -- Part 4
     (Val.scale (100 :: Natural) (Val.coin bal) >= Val.scale collPerc theFee)
       ?! InsufficientCollateral
@@ -349,26 +354,27 @@ utxoTransition = do
   {-   txins txb ≠ ∅   -}
   not (Set.null (getField @"inputs" txb)) ?!# InputSetEmptyUTxO
 
-  {-   feesOKp p tx utxo   -}
+  {-   feesOK pp tx utxo   -}
   feesOK pp tx utxo -- Generalizes the fee to small from earlier Era's
 
-  {-   (txins txb) ∪ (collateral txb)  ⊆ dom utxo   -}
-  eval (inputsAndCollateral ⊆ dom utxo)
-    ?! BadInputsUTxO (eval (inputsAndCollateral ➖ dom utxo))
+  {- badInputs = (txins txb ∪ collateral txb) ➖ dom utxo -}
+  let badInputs = Set.filter (`SplitMap.notMember` unUTxO utxo) inputsAndCollateral
+  {-   (txins txb) ∪ (collateral txb) ⊆ dom utxo   -}
+  Set.null badInputs ?! BadInputsUTxO badInputs
 
   {-   consumedpp utxo txb = producedpp poolParams txb    -}
   let consumed_ = consumed @era pp utxo txb
       produced_ = Shelley.produced @era pp (`Map.notMember` stakepools) txb
   consumed_ == produced_ ?! ValueNotConservedUTxO consumed_ produced_
 
-  {-   adaID  ∉ supp mint tx   -}
+  {-   adaID ∉ supp mint tx   -}
   -- Check that the mint field does not try to mint ADA.
   -- Here in the implementation, we store the adaId policyID in the coin field of the value.
   Val.coin (getField @"mint" txb) == Val.zero ?!# TriesToForgeADA
 
   {-   ∀ txout ∈ txouts txb, getValuetxout ≥ inject(uxoEntrySizetxout ∗ coinsPerUTxOWord p)   -}
   let (Coin coinsPerUTxOWord) = getField @"_coinsPerUTxOWord" pp
-      outputs = Map.elems $ unUTxO (txouts txb)
+      outputs = unUTxO (txouts txb)
       outputsTooSmall =
         filter
           ( \out ->
@@ -379,13 +385,13 @@ utxoTransition = do
                       v
                       (Val.inject $ Coin (utxoEntrySize out * coinsPerUTxOWord))
           )
-          outputs
+          (SplitMap.elems outputs)
   null outputsTooSmall ?! OutputTooSmallUTxO outputsTooSmall
 
   {-   ∀ txout ∈ txouts txb, serSize(getValuetxout) ≤ (maxTxSizep p)∗(maxValSizep pp)   -}
   -- use serialized length of Value because this Value size is being limited inside a serialized Tx
   let maxValSize = getField @"_maxValSize" pp
-      outputsTooBig = foldl' accum [] outputs
+      outputsTooBig = foldl' accum [] $ SplitMap.elems outputs
         where
           accum ans out =
             let v = getField @"value" out
@@ -404,7 +410,7 @@ utxoTransition = do
               AddrBootstrap addr -> bootstrapAddressAttrsSize addr > 64
               _ -> False
           )
-          outputs
+          (SplitMap.elems outputs)
   null outputsAttrsTooBig ?!# OutputBootAddrAttrsTooBig outputsAttrsTooBig
 
   {-   ∀(_ ↦ (a,_)) ∈ txouts txb, netId a = NetworkId   -}
@@ -586,7 +592,6 @@ decFail ::
     Applicative f,
     FromCBOR (f (Core.TxOut era)),
     FromCBOR (Core.Value era),
-    FromCBOR (f (UTxO era)),
     FromCBOR (f (PredicateFailure (Core.EraRule "UTXOS" era)))
   ) =>
   Word ->
@@ -611,7 +616,9 @@ decFail 12 =
           pure $ (,,) a b <$> fc
       )
 decFail 13 = Ann $ SumD InsufficientCollateral <! From <! From
-decFail 14 = SumD (pure ScriptsNotPaidUTxO) <*! From
+decFail 14 =
+  SumD (pure ScriptsNotPaidUTxO)
+    <*! D ((fmap UTxO . sequenceA) <$> decodeSplitMap fromCBOR fromCBOR)
 decFail 15 = Ann $ SumD ExUnitsTooBigUTxO <! From <! From
 decFail 16 = Ann $ SumD CollateralContainsNonADA <! From
 decFail 17 = Ann $ SumD WrongNetworkInTxBody <! From <! From

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxos.hs

@@ -35,7 +35,6 @@ import Cardano.Ledger.Alonzo.Tx
     DataHash,
     IsValid (..),
     ValidatedTx (..),
-    txouts,
   )
 import qualified Cardano.Ledger.Alonzo.TxBody as Alonzo
 import Cardano.Ledger.Alonzo.TxInfo (FailureDescription (..), ScriptResult (..))
@@ -58,16 +57,16 @@ import Cardano.Ledger.Shelley.LedgerState (PPUPState (..), UTxOState (..), keyRe
 import qualified Cardano.Ledger.Shelley.LedgerState as Shelley
 import Cardano.Ledger.Shelley.PParams (Update)
 import Cardano.Ledger.Shelley.Rules.Ppup (PPUP, PPUPEnv (..), PpupPredicateFailure)
-import Cardano.Ledger.Shelley.Rules.Utxo (UtxoEnv (..))
+import Cardano.Ledger.Shelley.Rules.Utxo (UtxoEnv (..), updateUTxOState)
 import Cardano.Ledger.Shelley.TxBody (DCert, Wdrl)
 import Cardano.Ledger.Shelley.UTxO (UTxO (..), balance, totalDeposits)
 import Cardano.Ledger.TxIn (TxIn (..))
 import Cardano.Ledger.Val as Val
 import Control.Monad.Except (MonadError (throwError))
 import Control.Monad.Trans.Reader (asks)
-import Control.SetAlgebra (eval, (∪), (⋪), (◁))
 import Control.State.Transition.Extended
 import Data.Coders
+import qualified Data.Compact.SplitMap as SplitMap
 import Data.Foldable (toList)
 import Data.Functor.Identity (Identity (..))
 import Data.List (intercalate)
@@ -150,9 +149,7 @@ utxosTransition =
 
 scriptsValidateTransition ::
   forall era.
-  ( Show (Core.Value era), -- Arises because of the use of (∪) from SetAlgebra, needs Show to report problems.
-    Era era,
-    Environment (Core.EraRule "PPUP" era) ~ PPUPEnv era,
+  ( Environment (Core.EraRule "PPUP" era) ~ PPUPEnv era,
     State (Core.EraRule "PPUP" era) ~ PPUPState era,
     Signal (Core.EraRule "PPUP" era) ~ Maybe (Update era),
     Embed (Core.EraRule "PPUP" era) (UTXOS era),
@@ -174,11 +171,7 @@ scriptsValidateTransition ::
   ) =>
   TransitionRule (UTXOS era)
 scriptsValidateTransition = do
-  TRC
-    ( UtxoEnv slot pp poolParams genDelegs,
-      UTxOState utxo deposited fees pup incStake,
-      tx
-      ) <-
+  TRC (UtxoEnv slot pp poolParams genDelegs, u@(UTxOState utxo _ _ pup _), tx) <-
     judgmentContext
   let txb = body tx
       refunded = keyRefunds pp txb
@@ -215,23 +208,12 @@ scriptsValidateTransition = do
               ]
           )
           ()
-  pup' <-
+  ppup' <-
     trans @(Core.EraRule "PPUP" era) $
       TRC
         (PPUPEnv slot pp genDelegs, pup, strictMaybeToMaybe $ getField @"update" txb)
 
-  let utxoAdd = txouts @era txb -- These will be inserted into the UTxO
-  let utxoDel = eval (getField @"inputs" txb ◁ utxo) -- These will be deleted fromthe UTxO
-  let newIncStakeDistro = updateStakeDistribution @era incStake utxoDel utxoAdd
-
-  pure $
-    UTxOState
-      { _utxo = eval ((getField @"inputs" txb ⋪ utxo) ∪ utxoAdd),
-        _deposited = deposited <> depositChange,
-        _fees = fees <> getField @"txfee" txb,
-        _ppups = pup',
-        _stakeDistro = newIncStakeDistro
-      }
+  pure $! updateUTxOState u txb depositChange ppup'
 
 scriptsNotValidateTransition ::
   forall era.
@@ -285,15 +267,15 @@ scriptsNotValidateTransition = do
               ]
           )
           ()
-  pure $
-    us
-      { _utxo = eval (getField @"collateral" txb ⋪ utxo),
-        _fees = fees <> Val.coin (balance @era (eval (getField @"collateral" txb ◁ utxo))),
-        _stakeDistro =
-          updateStakeDistribution @era
-            (_stakeDistro us)
-            (eval (getField @"collateral" txb ◁ utxo))
-            (UTxO Map.empty)
+      {- utxoKeep = getField @"collateral" txb ⋪ utxo -}
+      {- utxoDel  = getField @"collateral" txb ◁ utxo -}
+      !(!utxoKeep, !utxoDel) =
+        SplitMap.extractKeysSet (unUTxO utxo) (getField @"collateral" txb)
+  pure
+    $! us
+      { _utxo = UTxO utxoKeep,
+        _fees = fees <> Val.coin (balance (UTxO utxoDel)),
+        _stakeDistro = updateStakeDistribution (_stakeDistro us) (UTxO utxoDel) mempty
       }
 
 data TagMismatchDescription

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxow.hs

@@ -77,9 +77,10 @@ import Cardano.Ledger.Shelley.TxBody
     unWdrl,
   )
 import Cardano.Ledger.Shelley.UTxO (UTxO (..), txinLookup)
-import Control.SetAlgebra (domain, eval, (⊆), (◁), (➖))
+import Control.SetAlgebra (domain, eval, (⊆), (➖))
 import Control.State.Transition.Extended
 import Data.Coders
+import qualified Data.Compact.SplitMap as SplitMap
 import Data.Foldable (toList)
 import Data.Functor.Identity (Identity (..))
 import qualified Data.Map.Strict as Map
@@ -274,10 +275,10 @@ alonzoStyleWitness = do
 
   {-  { h | (_ → (a,_,h)) ∈ txins tx ◁ utxo, isNonNativeScriptAddress tx a} = dom(txdats txw)   -}
   let inputs = getField @"inputs" txbody :: (Set (TxIn (Crypto era)))
-      smallUtxo = eval (inputs ◁ utxo) :: Map.Map (TxIn (Crypto era)) (Core.TxOut era)
+      smallUtxo = inputs SplitMap.◁ unUTxO utxo
       twoPhaseOuts =
         [ output
-          | (_input, output) <- Map.toList smallUtxo,
+          | (_input, output) <- SplitMap.toList smallUtxo,
             isTwoPhaseScriptAddress @era tx (getField @"address" output)
         ]
       utxoHashes' = mapM (getField @"datahash") twoPhaseOuts
@@ -287,7 +288,7 @@ alonzoStyleWitness = do
       -- of the equality check, but we must explicitly rule it out.
       failBecause . UnspendableUTxONoDatumHash . Set.fromList $
         [ input
-          | (input, output) <- Map.toList smallUtxo,
+          | (input, output) <- SplitMap.toList smallUtxo,
             SNothing <- [getField @"datahash" output],
             isTwoPhaseScriptAddress @era tx (getField @"address" output)
         ]

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Tools.hs

@@ -39,6 +39,7 @@ import Cardano.Ledger.Shelley.UTxO (UTxO (..), unUTxO)
 import Cardano.Slotting.EpochInfo.API (EpochInfo)
 import Cardano.Slotting.Time (SystemStart)
 import Data.Array (Array, array, bounds, (!))
+import qualified Data.Compact.SplitMap as SplitMap
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
 import Data.Set (Set)
@@ -98,7 +99,7 @@ basicValidation tx utxo =
   where
     txb = getField @"body" tx
     ins = getField @"inputs" txb
-    badIns = Set.filter (`Map.notMember` (unUTxO utxo)) ins
+    badIns = Set.filter (`SplitMap.notMember` unUTxO utxo) ins
 
 type RedeemerReport c = Map RdmrPtr (Either (ScriptFailure c) ExUnits)
 
@@ -169,7 +170,7 @@ evaluateTransactionExecutionUnits pp tx utxo ei sysS costModels = do
         if l1 <= lang && lang <= l2 then Right (costModels ! lang) else Left (NoCostModel lang)
       args <- case sp of
         (Spending txin) -> do
-          txOut <- note (UnknownTxIn txin) $ Map.lookup txin (unUTxO utxo)
+          txOut <- note (UnknownTxIn txin) $ SplitMap.lookup txin (unUTxO utxo)
           let TxOut _ _ mdh = txOut
           dh <- note (InvalidTxIn txin) $ strictMaybeToMaybe mdh
           dat <- note (MissingDatum dh) $ Map.lookup dh dats

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxInfo.hs

@@ -16,8 +16,6 @@ import Cardano.Crypto.Hash.Class (Hash, hashToBytes)
 import Cardano.Ledger.Address (Addr (..), RewardAcnt (..))
 import Cardano.Ledger.Alonzo.Data (Data (..), getPlutusData)
 import Cardano.Ledger.Alonzo.Language (Language (..))
--- Instances only
-
 import Cardano.Ledger.Alonzo.Scripts (CostModel (..), ExUnits (..), Script (..), decodeCostModel)
 import Cardano.Ledger.Alonzo.Tx
 import Cardano.Ledger.Alonzo.TxBody
@@ -76,6 +74,7 @@ import Data.Coders
     (!>),
     (<!),
   )
+import qualified Data.Compact.SplitMap as SplitMap
 import Data.Fixed (HasResolution (resolution))
 import qualified Data.Map as Map
 import Data.Maybe (mapMaybe)
@@ -202,7 +201,7 @@ txInfoIn ::
   TxIn (Crypto era) ->
   Maybe PV1.TxInInfo
 txInfoIn (UTxO mp) txin =
-  case Map.lookup txin mp of
+  case SplitMap.lookup txin mp of
     Nothing -> Nothing
     Just txout -> case transAddr addr of
       Just ad -> Just (PV1.TxInInfo (txInfoIn' txin) (PV1.TxOut ad valout dhash))

eras/alonzo/test-suite/cardano-ledger-alonzo-test.cabal

@@ -60,6 +60,7 @@ library
     cardano-ledger-shelley-ma,
     cardano-protocol-tpraos,
     cardano-slotting,
+    compact-map,
     containers,
     data-default-class,
     hashable,
@@ -68,7 +69,6 @@ library
     QuickCheck,
     cardano-ledger-shelley-test,
     cardano-ledger-shelley,
-    set-algebra,
     strict-containers,
     text,
   hs-source-dirs:
@@ -104,6 +104,7 @@ test-suite cardano-ledger-alonzo-test
     cardano-ledger-shelley-ma-test,
     cardano-protocol-tpraos,
     cardano-slotting,
+    compact-map,
     containers,
     data-default-class,
     plutus-core,