WIP Change STS from LEDGER down to use ILC Diff

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

@@ -58,6 +58,7 @@ library
         aeson,
         bytestring,
         cardano-crypto-class,
+        cardano-data,
         cardano-ledger-binary >=1.1,
         cardano-ledger-allegra >=1.1,
         cardano-ledger-alonzo >=1.1,
@@ -97,3 +98,22 @@ library testlib
         cardano-ledger-core,
         cardano-ledger-mary:testlib,
         small-steps
+
+test-suite tests
+    type:             exitcode-stdio-1.0
+    main-is:          Main.hs
+    hs-source-dirs:   test
+    other-modules:    Test.Cardano.Ledger.Conway.DiffSpec
+    default-language: Haskell2010
+    ghc-options:
+        -Wall -Wcompat -Wincomplete-record-updates
+        -Wincomplete-uni-patterns -Wredundant-constraints -Wpartial-fields
+        -Wunused-packages -threaded -rtsopts -with-rtsopts=-N
+
+    build-depends:
+        base,
+        cardano-ledger-core:{cardano-ledger-core, testlib},
+        cardano-ledger-conway,
+        testlib,
+        cardano-ledger-core,
+        cardano-data:testlib

eras/conway/impl/src/Cardano/Ledger/Conway/Governance.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
@@ -37,6 +38,7 @@ module Cardano.Ledger.Conway.Governance (
   GovernanceProcedure (..),
   Anchor (..),
   AnchorDataHash,
+  Diff (EnactState', RatifyState', ConwayGovernance'),
 ) where
 
 import Cardano.Crypto.Hash.Class (hashToTextAsHex)
@@ -74,6 +76,14 @@ import Data.Aeson (KeyValue, ToJSON (..), object, pairs, (.=))
 import Data.Aeson.Types (ToJSONKey (..), toJSONKeyText)
 import Data.ByteString (ByteString)
 import Data.Default.Class (Default (..))
+import Data.Functor.Identity (Identity)
+import Data.Incremental (
+  Diff (Total', Zero),
+  ILC (..),
+  Total,
+  applyTotal,
+  ($$),
+ )
 import Data.Map.Strict (Map)
 import Data.Sequence.Strict (StrictSeq)
 import Data.Set (Set)
@@ -438,6 +448,16 @@ data EnactState era = EnactState
   }
   deriving (Generic)
 
+instance ILC (EnactState era) where
+  newtype Diff (EnactState era) = EnactState' (Diff (Total (EnactState era)))
+  applyDiff x (EnactState' y) = applyTotal x y
+  extend (EnactState' x) (EnactState' y) = EnactState' $ extend x y
+  zero = EnactState' Zero
+  totalDiff x = EnactState' (Total' x)
+
+deriving instance Eq (PParamsHKD Identity era) => Eq (Diff (EnactState era))
+deriving instance Show (PParamsHKD Identity era) => Show (Diff (EnactState era))
+
 instance EraPParams era => ToJSON (EnactState era) where
   toJSON = object . toEnactStatePairs
   toEncoding = pairs . mconcat . toEnactStatePairs
@@ -453,8 +473,7 @@ toEnactStatePairs cg@(EnactState _ _ _ _ _ _) =
       , "withdrawals" .= ensWithdrawals
       ]
 
-deriving instance Eq (PParams era) => Eq (EnactState era)
-
+deriving instance (Eq (PParamsHKD Identity era), Eq (PParams era)) => Eq (EnactState era)
 deriving instance Show (PParams era) => Show (EnactState era)
 
 instance EraPParams era => Default (EnactState era) where
@@ -505,6 +524,29 @@ data RatifyState era = RatifyState
   }
   deriving (Generic, Eq, Show)
 
+instance ILC (RatifyState era) where
+  data Diff (RatifyState era) = RatifyState'
+    { diffRsEnactState :: !(Diff (EnactState era))
+    , diffRsFuture :: !(Diff (Total (StrictSeq (GovernanceActionId (EraCrypto era), GovernanceActionState era))))
+    }
+  applyDiff RatifyState {..} RatifyState' {..} =
+    RatifyState
+      { rsEnactState = rsEnactState $$ diffRsEnactState
+      , rsFuture = case diffRsFuture of
+          Zero -> rsFuture
+          Total' x -> x
+      }
+  extend x y =
+    RatifyState'
+      { diffRsEnactState = extend (diffRsEnactState x) (diffRsEnactState y)
+      , diffRsFuture = extend (diffRsFuture x) (diffRsFuture y)
+      }
+  zero = RatifyState' zero zero
+  totalDiff (RatifyState x y) = RatifyState' (totalDiff x) (Total' y)
+
+deriving instance EraPParams era => Eq (Diff (RatifyState era))
+deriving instance EraPParams era => Show (Diff (RatifyState era))
+
 instance EraPParams era => Default (RatifyState era)
 
 instance EraPParams era => DecCBOR (RatifyState era) where
@@ -549,6 +591,31 @@ data ConwayGovernance era = ConwayGovernance
   }
   deriving (Generic, Eq, Show)
 
+instance ILC (ConwayGovernance era) where
+  data Diff (ConwayGovernance era) = ConwayGovernance'
+    { diffCgTally :: !(Diff (Map (GovernanceActionId (EraCrypto era)) (GovernanceActionState era)))
+    , diffCgRatify :: !(Diff (RatifyState era))
+    , diffCgVoterRoles :: !(Diff (Map (Credential 'Voting (EraCrypto era)) VoterRole))
+    }
+  applyDiff ConwayGovernance {..} ConwayGovernance' {..} =
+    ConwayGovernance
+      { cgTally = ConwayTallyState (unConwayTallyState cgTally $$ diffCgTally)
+      , cgRatify = cgRatify $$ diffCgRatify
+      , cgVoterRoles = cgVoterRoles $$ diffCgVoterRoles
+      }
+  extend x y =
+    ConwayGovernance'
+      { diffCgTally = extend (diffCgTally x) (diffCgTally y)
+      , diffCgRatify = extend (diffCgRatify x) (diffCgRatify y)
+      , diffCgVoterRoles = extend (diffCgVoterRoles x) (diffCgVoterRoles y)
+      }
+  zero = ConwayGovernance' zero zero zero
+  totalDiff (ConwayGovernance (ConwayTallyState x) y z) =
+    ConwayGovernance' (totalDiff x) (totalDiff y) (totalDiff z)
+
+deriving instance (EraPParams era) => (Eq (Diff (ConwayGovernance era)))
+deriving instance (EraPParams era) => (Show (Diff (ConwayGovernance era)))
+
 cgTallyL :: Lens' (ConwayGovernance era) (ConwayTallyState era)
 cgTallyL = lens cgTally (\x y -> x {cgTally = y})
 

eras/conway/impl/test/Main.hs

@@ -0,0 +1,10 @@
+module Main where
+
+import Test.Cardano.Ledger.Common
+import Test.Cardano.Ledger.Conway.DiffSpec (conwayDiffSpecs)
+
+main :: IO ()
+main =
+  ledgerTestMain $
+    describe "Conway tests" $ do
+      conwayDiffSpecs

eras/conway/impl/test/Test/Cardano/Ledger/Conway/DiffSpec.hs

@@ -0,0 +1,31 @@
+{-# LANGUAGE TypeApplications #-}
+
+module Test.Cardano.Ledger.Conway.DiffSpec (conwayDiffSpecs) where
+
+import Cardano.Ledger.Conway (ConwayEra)
+import Cardano.Ledger.Conway.Governance
+import Cardano.Ledger.Crypto (StandardCrypto)
+import Test.Cardano.Data (
+  propExtend,
+  propZero,
+ )
+import Test.Cardano.Ledger.Common
+import Test.Cardano.Ledger.Conway.Arbitrary ()
+
+-- ==========================================================
+
+conwayDiffSpecs :: Spec
+conwayDiffSpecs = describe "ILC Diff tests" $ do
+  describe "Diff EnactState" $ do
+    propZero (arbitrary @(EnactState (ConwayEra StandardCrypto)))
+    propExtend (arbitrary @(EnactState (ConwayEra StandardCrypto))) arbitrary
+  describe "Diff RatifyState" $ do
+    propZero (arbitrary @(RatifyState (ConwayEra StandardCrypto)))
+    propExtend (arbitrary @(RatifyState (ConwayEra StandardCrypto))) arbitrary
+  describe "Diff GovernanceState" $ do
+    propZero (arbitrary @(GovernanceState (ConwayEra StandardCrypto)))
+    propExtend (arbitrary @(GovernanceState (ConwayEra StandardCrypto))) arbitrary
+
+-- To run theses tests in ghci, uncomment and type 'main'
+-- main :: IO ()
+-- main = hspec $ conwayDiffSpecs

eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Arbitrary.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeFamilies #-}
@@ -8,6 +9,7 @@
 
 module Test.Cardano.Ledger.Conway.Arbitrary () where
 
+import Cardano.Ledger.BaseTypes (StrictMaybe)
 import Cardano.Ledger.Binary (Sized)
 import Cardano.Ledger.Conway.Core
 import Cardano.Ledger.Conway.Delegation.Certificates
@@ -17,6 +19,7 @@ import Cardano.Ledger.Conway.Rules
 import Cardano.Ledger.Conway.TxBody
 import Cardano.Ledger.Crypto (Crypto)
 import Control.State.Transition.Extended (STS (Event))
+import Data.Functor.Identity (Identity)
 import Test.Cardano.Ledger.Alonzo.Arbitrary ()
 import Test.Cardano.Ledger.Babbage.Arbitrary ()
 import Test.Cardano.Ledger.Common
@@ -230,3 +233,40 @@ instance
   Arbitrary (ConwayTickfEvent era)
   where
   arbitrary = undefined
+
+------------------------------------------------------------------------------------------
+-- Cardano.Ledger.Conway ILC instances ---------------------------------------------------
+------------------------------------------------------------------------------------------
+{-
+src/Cardano/Ledger/Conway/Governance.hs
+448:instance ILC (EnactState era) where
+521:instance ILC (RatifyState era) where
+584:instance ILC (ConwayGovernance era) where
+-}
+
+instance
+  ( Era era
+  , Arbitrary (PParamsHKD Identity era)
+  , Arbitrary (PParamsHKD StrictMaybe era)
+  ) =>
+  Arbitrary (Diff (EnactState era))
+  where
+  arbitrary = EnactState' <$> arbitrary
+
+instance
+  ( Era era
+  , Arbitrary (PParamsHKD Identity era)
+  , Arbitrary (PParamsHKD StrictMaybe era)
+  ) =>
+  Arbitrary (Diff (RatifyState era))
+  where
+  arbitrary = RatifyState' <$> arbitrary <*> arbitrary
+
+instance
+  ( Era era
+  , Arbitrary (PParamsHKD Identity era)
+  , Arbitrary (PParamsHKD StrictMaybe era)
+  ) =>
+  Arbitrary (Diff (ConwayGovernance era))
+  where
+  arbitrary = ConwayGovernance' <$> arbitrary <*> arbitrary <*> arbitrary

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

@@ -74,9 +74,10 @@ test-suite cardano-ledger-conway-test
         bytestring,
         cardano-ledger-allegra,
         cardano-ledger-alonzo,
+        cardano-data:testlib,
         cardano-ledger-babbage,
-        cardano-ledger-conway,
+        cardano-ledger-conway:{cardano-ledger-conway, testlib},
         cardano-ledger-conway-test,
-        cardano-ledger-core,
+        cardano-ledger-core:{cardano-ledger-core, testlib},
         cardano-ledger-shelley-test,
         tasty

eras/conway/test-suite/test/Tests.hs

@@ -4,6 +4,7 @@
 module Main where
 
 import Cardano.Ledger.Conway (Conway)
+import Test.Cardano.Ledger.Common (hspec)
 import qualified Test.Cardano.Ledger.Conway.Serialisation.CDDL as CDDL
 import qualified Test.Cardano.Ledger.Conway.Serialisation.Roundtrip as Roundtrip
 import Test.Tasty (TestTree, defaultMain, testGroup)

eras/shelley/impl/src/Cardano/Ledger/Shelley/Governance.hs

@@ -1,5 +1,7 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -11,6 +13,7 @@
 module Cardano.Ledger.Shelley.Governance (
   EraGovernance (..),
   ShelleyPPUPState (..),
+  Diff (ShelleyPPUPState'),
 ) where
 
 import Cardano.Ledger.Binary (
@@ -23,13 +26,16 @@ import Cardano.Ledger.Binary (
 import Cardano.Ledger.Binary.Coders (Decode (..), decode, (<!))
 import Cardano.Ledger.Core
 import Cardano.Ledger.Crypto (Crypto)
+import Cardano.Ledger.Keys (KeyHash, KeyRole (..))
 import Cardano.Ledger.Shelley.Era (ShelleyEra)
-import Cardano.Ledger.Shelley.PParams (ProposedPPUpdates, emptyPPPUpdates)
+import Cardano.Ledger.Shelley.PParams (ProposedPPUpdates (..), emptyPPPUpdates)
 import Cardano.Ledger.TreeDiff (ToExpr)
 import Control.DeepSeq (NFData)
 import Data.Aeson (KeyValue, ToJSON (..), object, pairs, (.=))
 import Data.Default.Class (Default (..))
+import Data.Incremental (ILC (..), ($$))
 import Data.Kind (Type)
+import Data.Map (Map)
 import GHC.Generics (Generic)
 import NoThunks.Class (NoThunks (..))
 
@@ -72,6 +78,28 @@ data ShelleyPPUPState era = ShelleyPPUPState
   }
   deriving (Generic)
 
+instance ILC (ShelleyPPUPState era) where
+  data Diff (ShelleyPPUPState era) = ShelleyPPUPState'
+    { diffProposals :: !(Diff (Map (KeyHash 'Genesis (EraCrypto era)) (PParamsUpdate era)))
+    , diffFutureProposals :: !(Diff (Map (KeyHash 'Genesis (EraCrypto era)) (PParamsUpdate era)))
+    }
+  applyDiff ShelleyPPUPState {..} ShelleyPPUPState' {..} =
+    ShelleyPPUPState
+      { proposals = ProposedPPUpdates (unProposedPPUpdates proposals $$ diffProposals)
+      , futureProposals = ProposedPPUpdates (unProposedPPUpdates futureProposals $$ diffProposals)
+      }
+  extend x y =
+    ShelleyPPUPState'
+      { diffProposals = extend (diffProposals x) (diffProposals y)
+      , diffFutureProposals = extend (diffFutureProposals x) (diffFutureProposals y)
+      }
+  zero = ShelleyPPUPState' zero zero
+  totalDiff _ = ShelleyPPUPState' zero zero
+
+deriving instance Show (PParamsUpdate era) => Show (Diff (ShelleyPPUPState era))
+
+deriving instance Eq (PParamsUpdate era) => Eq (Diff (ShelleyPPUPState era))
+
 deriving instance Show (PParamsUpdate era) => Show (ShelleyPPUPState era)
 
 deriving instance Eq (PParamsUpdate era) => Eq (ShelleyPPUPState era)

eras/shelley/impl/src/Cardano/Ledger/Shelley/LedgerState.hs

@@ -94,6 +94,9 @@ module Cardano.Ledger.Shelley.LedgerState (
   lsUTxOStateL,
   utxosFeesL,
   utxosGovernanceL,
+
+  -- * ILC instances
+  Diff (IStake', UTxOState', LedgerState'),
 ) where
 
 import Cardano.Ledger.DPState