Split Crypto into Crypto and HeaderCrypto

- Split Crypto class into Crypto (DSIGN, ADDRHASH) and HeaderCrypto (KES, VRF)
- Move HeaderCrypto into Cardano.Protocol
- Use PoolStakeVRF and GenesisVRF as a proxy to VRF in ledger code
- Parametrize TPrao protcol code with Crypto and HeaderCrypto
  Many functions are parametrized by Era and HeaderCrypto as Era implicitly
  implies Crypto (Crypto Era).
- ALl the ledger code is separated from header crypto (KES/VRF)
- Proxy VRFs are PoolStakeVRF and GenesisVRF

Signed-off-by: Yogesh Sajanikar <[email protected]>

cabal.project

@@ -38,6 +38,7 @@ packages:
   libs/cardano-ledger-core
   libs/cardano-ledger-binary
   libs/cardano-ledger-pretty
+  libs/cardano-protocol-core
   libs/cardano-protocol-tpraos
   libs/non-integral
   libs/small-steps

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

@@ -45,6 +45,7 @@ library
     build-depends:
         base >=4.14 && <4.17,
         bytestring,
+        cardano-crypto-class,
         cardano-ledger-alonzo:{cardano-ledger-alonzo, testlib} >=1.2,
         cardano-ledger-binary:{cardano-ledger-binary, testlib} >=1.0,
         cardano-ledger-core:{cardano-ledger-core, testlib} >=1.0,
@@ -54,6 +55,7 @@ library
         cardano-ledger-shelley-test ^>=1.1,
         cardano-ledger-mary ^>=1.1,
         cardano-ledger-shelley-ma-test ^>=1.1,
+        cardano-protocol-core,
         cardano-protocol-tpraos ^>=1.0,
         cardano-slotting,
         cardano-strict-containers,

eras/alonzo/test-suite/src/Test/Cardano/Ledger/Alonzo/AlonzoEraGen.hs

@@ -11,6 +11,8 @@
 -- |  AlonzoEra instances for EraGen and ScriptClass
 module Test.Cardano.Ledger.Alonzo.AlonzoEraGen where
 
+import qualified Cardano.Crypto.DSIGN as DSIGN
+import Cardano.Crypto.Util (SignableRepresentation)
 import Cardano.Ledger.Address (Addr (..))
 import Cardano.Ledger.Allegra.Scripts (Timelock (..), translateTimelock)
 import Cardano.Ledger.Allegra.TxAuxData (AllegraTxAuxData (..))
@@ -109,7 +111,7 @@ import Test.Cardano.Ledger.Alonzo.PlutusScripts (
  )
 import Test.Cardano.Ledger.Binary.Random
 import Test.Cardano.Ledger.MaryEraGen (addTokens, genMint, maryGenesisValue, policyIndex)
-import Test.Cardano.Ledger.Shelley.ConcreteCryptoTypes (Mock)
+import Test.Cardano.Ledger.Shelley.ConcreteCryptoTypes (MockContext)
 import Test.Cardano.Ledger.Shelley.Constants (Constants (..))
 import Test.Cardano.Ledger.Shelley.Generator.Core (
   GenEnv (..),
@@ -131,10 +133,10 @@ import Test.QuickCheck hiding ((><))
 -- ============================================================
 
 -- | We are choosing new TxOut to pay fees, We want only Key locked addresss with Ada only values.
-vKeyLockedAdaOnly :: Mock c => TxOut (AlonzoEra c) -> Bool
+vKeyLockedAdaOnly :: Crypto c => TxOut (AlonzoEra c) -> Bool
 vKeyLockedAdaOnly txOut = vKeyLocked txOut && isAdaOnly (txOut ^. valueTxOutL)
 
-phase2scripts3Arg :: forall c. Mock c => [TwoPhase3ArgInfo (AlonzoEra c)]
+phase2scripts3Arg :: forall c. Crypto c => [TwoPhase3ArgInfo (AlonzoEra c)]
 phase2scripts3Arg =
   [ TwoPhase3ArgInfo
       (alwaysSucceeds PlutusV1 3)
@@ -154,7 +156,7 @@ phase2scripts3Arg =
       False
   ]
 
-phase2scripts2Arg :: forall c. Mock c => [TwoPhase2ArgInfo (AlonzoEra c)]
+phase2scripts2Arg :: forall c. Crypto c => [TwoPhase2ArgInfo (AlonzoEra c)]
 phase2scripts2Arg =
   [ TwoPhase2ArgInfo
       (alwaysSucceeds PlutusV1 2)
@@ -167,21 +169,21 @@ phase2scripts2Arg =
   , TwoPhase2ArgInfo (alwaysFails PlutusV1 2) (hashScript @(AlonzoEra c) (alwaysFails PlutusV1 2)) (P.I 1, bigMem, bigStep) False
   ]
 
-phase2scripts3ArgSucceeds :: forall c. Mock c => AlonzoScript (AlonzoEra c) -> Bool
+phase2scripts3ArgSucceeds :: forall c. Crypto c => AlonzoScript (AlonzoEra c) -> Bool
 phase2scripts3ArgSucceeds script =
   maybe True getSucceeds3 $
     List.find (\info -> getScript3 @(AlonzoEra c) info == script) phase2scripts3Arg
 
-phase2scripts2ArgSucceeds :: forall c. Mock c => AlonzoScript (AlonzoEra c) -> Bool
+phase2scripts2ArgSucceeds :: forall c. Crypto c => AlonzoScript (AlonzoEra c) -> Bool
 phase2scripts2ArgSucceeds script =
   maybe True getSucceeds2 $
     List.find (\info -> getScript2 @(AlonzoEra c) info == script) phase2scripts2Arg
 
-genPlutus2Arg :: Mock c => Gen (Maybe (TwoPhase2ArgInfo (AlonzoEra c)))
+genPlutus2Arg :: Crypto c => Gen (Maybe (TwoPhase2ArgInfo (AlonzoEra c)))
 genPlutus2Arg = frequency [(10, Just <$> elements phase2scripts2Arg), (90, pure Nothing)]
 
 -- | Gen a Mint value in the Alonzo Era, with a 10% chance that it includes an AlonzoScript
-genAlonzoMint :: Mock c => MultiAsset c -> Gen (MultiAsset c, [AlonzoScript (AlonzoEra c)])
+genAlonzoMint :: Crypto c => MultiAsset c -> Gen (MultiAsset c, [AlonzoScript (AlonzoEra c)])
 genAlonzoMint startvalue = do
   ans <- genPlutus2Arg
   case ans of
@@ -216,7 +218,7 @@ genSet gen =
     , (1, Set.fromList <$> sequence [gen, gen])
     ]
 
-genAux :: forall c. Mock c => Constants -> Gen (StrictMaybe (AlonzoTxAuxData (AlonzoEra c)))
+genAux :: forall c. Crypto c => Constants -> Gen (StrictMaybe (AlonzoTxAuxData (AlonzoEra c)))
 genAux constants = do
   maybeAux <- genEraAuxiliaryData @(MaryEra c) constants
   pure $
@@ -238,14 +240,14 @@ unTime :: AlonzoScript era -> Timelock era
 unTime (TimelockScript x) = x
 unTime (PlutusScript _ _) = error "Plutus in Timelock"
 
-okAsCollateral :: forall c. Mock c => UTxO (AlonzoEra c) -> TxIn c -> Bool
+okAsCollateral :: forall c. Crypto c => UTxO (AlonzoEra c) -> TxIn c -> Bool
 okAsCollateral utxo inputx =
   maybe False vKeyLockedAdaOnly $ Map.lookup inputx (unUTxO utxo)
 
 genAlonzoTxBody ::
-  forall c.
-  Mock c =>
-  GenEnv (AlonzoEra c) ->
+  forall c hc.
+  (MockContext c) =>
+  GenEnv (AlonzoEra c) hc ->
   UTxO (AlonzoEra c) ->
   PParams (AlonzoEra c) ->
   SlotNo ->
@@ -366,7 +368,7 @@ bigMem = 50000
 bigStep :: Natural
 bigStep = 99999
 
-instance Mock c => EraGen (AlonzoEra c) where
+instance (MockContext c, DSIGN.Signable (DSIGN c) ~ SignableRepresentation) => EraGen (AlonzoEra c) where
   genEraAuxiliaryData = genAux
   genGenesisValue = maryGenesisValue
   genEraTwoPhase3Arg = phase2scripts3Arg
@@ -517,7 +519,7 @@ getDataMap (scriptInfo3, _) = Map.foldlWithKey' accum Map.empty
         Just (TwoPhase3ArgInfo _script _hash dat _redeem _) ->
           Map.insert (hashData @era dat) (Data dat) ans
 
-instance Mock c => MinGenTxout (AlonzoEra c) where
+instance MockContext c => MinGenTxout (AlonzoEra c) where
   calcEraMinUTxO txOut pp = utxoEntrySize txOut <×> unCoinPerWord (pp ^. ppCoinsPerUTxOWordL)
   addValToTxOut v (AlonzoTxOut a u _b) = AlonzoTxOut a (v <+> u) (dataFromAddr a)
   genEraTxOut genv genVal addrs = do
@@ -532,7 +534,7 @@ instance Mock c => MinGenTxout (AlonzoEra c) where
 -- | If an Address is script address, we can find a potential data hash for it from
 --   genEraTwoPhase3Arg, which contains all known 3 arg plutus scripts in the tests set.
 -- If the script has is not in that map, then its data hash is SNothing.
-dataFromAddr :: forall c. Mock c => Addr c -> StrictMaybe (DataHash c)
+dataFromAddr :: forall c. MockContext c => Addr c -> StrictMaybe (DataHash c)
 dataFromAddr (Addr _network (ScriptHashObj shash) _stakeref) =
   let f info = shash == hashScript @(AlonzoEra c) (getScript3 @(AlonzoEra c) info)
    in case List.find f genEraTwoPhase3Arg of
@@ -544,7 +546,7 @@ dataFromAddr _ = SNothing
 --   genEraTwoPhase3Arg, which contains all known 3 arg plutus scripts stores the data.
 dataMapFromTxOut ::
   forall c.
-  Mock c =>
+  MockContext c =>
   [TxOut (AlonzoEra c)] ->
   TxDats (AlonzoEra c) ->
   TxDats (AlonzoEra c)
@@ -557,7 +559,7 @@ dataMapFromTxOut txouts datahashmap = Prelude.foldl accum datahashmap txouts
         Just info -> TxDats (Map.insert dhash (Data (getData3 info)) m)
         Nothing -> ans
 
-addMaybeDataHashToTxOut :: Mock c => TxOut (AlonzoEra c) -> TxOut (AlonzoEra c)
+addMaybeDataHashToTxOut :: MockContext c => TxOut (AlonzoEra c) -> TxOut (AlonzoEra c)
 addMaybeDataHashToTxOut (AlonzoTxOut addr val _) = AlonzoTxOut addr val (dataFromAddr addr)
 
 someLeaf ::

eras/alonzo/test-suite/src/Test/Cardano/Ledger/Alonzo/Examples/Consensus.hs

@@ -52,11 +52,11 @@ import qualified Test.Cardano.Ledger.Mary.Examples.Consensus as SLE
 import qualified Test.Cardano.Ledger.Shelley.Examples.Consensus as SLE
 
 -- | ShelleyLedgerExamples for Alonzo era
-ledgerExamplesAlonzo :: SLE.ShelleyLedgerExamples Alonzo
+ledgerExamplesAlonzo :: SLE.ShelleyLedgerExamples Alonzo StandardCrypto
 ledgerExamplesAlonzo =
   SLE.ShelleyLedgerExamples
     { SLE.sleBlock = SLE.exampleShelleyLedgerBlock exampleTransactionInBlock
-    , SLE.sleHashHeader = SLE.exampleHashHeader (Proxy @Alonzo)
+    , SLE.sleHashHeader = SLE.exampleHashHeader (Proxy @Alonzo) (Proxy @StandardCrypto)
     , SLE.sleTx = exampleTransactionInBlock
     , SLE.sleApplyTxError =
         ApplyTxError $
@@ -79,7 +79,7 @@ ledgerExamplesAlonzo =
       SLE.ShelleyResultExamples
         { SLE.srePParams = def
         , SLE.sreProposedPPUpdates = examplePPPU
-        , SLE.srePoolDistr = SLE.examplePoolDistr
+        , SLE.srePoolDistr = SLE.examplePoolDistr (Proxy @StandardCrypto) (Proxy @StandardCrypto)
         , SLE.sreNonMyopicRewards = SLE.exampleNonMyopicRewards
         , SLE.sreShelleyGenesis = SLE.testShelleyGenesis
         }
@@ -101,7 +101,7 @@ exampleTxBodyAlonzo =
             (SJust $ SLE.mkDummySafeHash Proxy 1) -- outputs
         ]
     )
-    SLE.exampleCerts -- txcerts
+    (SLE.exampleCerts (Proxy @StandardCrypto)) -- txcerts
     ( Withdrawals $
         Map.singleton
           (RewardAcnt Testnet (SLE.keyToCredential SLE.exampleStakeKey))
@@ -162,6 +162,7 @@ exampleTransactionInBlock = AlonzoTx b w (IsValid True) a
 exampleAlonzoNewEpochState :: NewEpochState Alonzo
 exampleAlonzoNewEpochState =
   SLE.exampleNewEpochState
+    (Proxy @StandardCrypto)
     (SLE.exampleMultiAssetValue 1)
     emptyPParams
     (emptyPParams & ppCoinsPerUTxOWordL .~ CoinPerWord (Coin 1))

eras/alonzo/test-suite/src/Test/Cardano/Ledger/Alonzo/Trace.hs

@@ -46,7 +46,7 @@ import Test.Cardano.Ledger.Shelley.Generator.Utxo (genTx)
 instance
   ( EraGen era
   , AlonzoEraTx era
-  , Mock (EraCrypto era)
+  , Mock (EraCrypto era) hc
   , MinLEDGER_STS era
   , Embed (EraRule "DELPL" era) (CERTS era)
   , Environment (EraRule "DELPL" era) ~ DelplEnv era
@@ -63,8 +63,9 @@ instance
   , Signal (EraRule "DELEGS" era) ~ Seq (DCert (EraCrypto era))
   , Tx era ~ AlonzoTx era
   , ProtVerAtMost era 8
+  , c ~ EraCrypto era
   ) =>
-  TQC.HasTrace (AlonzoLEDGER era) (GenEnv era)
+  TQC.HasTrace (AlonzoLEDGER era) (GenEnv era hc)
   where
   envGen GenEnv {geConstants} =
     LedgerEnv (SlotNo 0) minBound

eras/alonzo/test-suite/test/Test/Cardano/Ledger/Alonzo/ChainTrace.hs

@@ -59,7 +59,7 @@ import qualified Test.Tasty.QuickCheck as TQC
 
 type A = AlonzoEra TestCrypto
 
-instance Embed (AlonzoBBODY A) (CHAIN A) where
+instance Embed (AlonzoBBODY A) (CHAIN A TestCrypto) where
   wrapFailed = BbodyFailure
   wrapEvent = BbodyEvent
 
@@ -76,7 +76,7 @@ tests =
       conjoin $ map alonzoSpecificProps (sourceSignalTargets tr)
 
 alonzoSpecificProps ::
-  SourceSignalTarget (CHAIN A) ->
+  SourceSignalTarget (CHAIN A TestCrypto) ->
   Property
 alonzoSpecificProps SourceSignalTarget {source = chainSt, signal = block} =
   conjoin $

eras/alonzo/test-suite/test/Test/Cardano/Ledger/Alonzo/Golden.hs

@@ -234,7 +234,7 @@ goldenMinFee =
             txsSeq =
               case decodeFullAnnotator (eraProtVerHigh @Alonzo) "Block" decCBOR cborBytesBlock of
                 Left err -> error (show err)
-                Right (Block _h txs :: Block (BHeader StandardCrypto) Alonzo) -> txs
+                Right (Block _h txs :: Block (BHeader StandardCrypto StandardCrypto) Alonzo) -> txs
             firstTx =
               case fromTxSeq @Alonzo txsSeq of
                 tx :<| _ -> tx

eras/alonzo/test-suite/test/Test/Cardano/Ledger/Alonzo/Serialisation/Tripping.hs

@@ -102,7 +102,7 @@ tests =
           (eraProtVerLow @Alonzo)
           (eraProtVerHigh @Alonzo)
     , testProperty "alonzo/Block" $
-        roundTripAnnRangeExpectation @(Block (BHeader StandardCrypto) Alonzo)
+        roundTripAnnRangeExpectation @(Block (BHeader StandardCrypto StandardCrypto) Alonzo)
           (eraProtVerLow @Alonzo)
           (eraProtVerHigh @Alonzo)
     ]

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

@@ -39,7 +39,7 @@ defaultTests :: TestTree
 defaultTests =
   testGroup
     "Alonzo tests"
-    [ AdaPreservation.tests @A @(AlonzoLEDGER A) 50
+    [ AdaPreservation.tests @A @(AlonzoLEDGER A) @TestCrypto 50
     , Tripping.tests
     , Translation.tests
     , Canonical.tests
@@ -53,8 +53,8 @@ nightlyTests :: TestTree
 nightlyTests =
   testGroup
     "Alonzo tests - nightly"
-    $ Shelley.commonTests @A @(AlonzoLEDGER A)
+    $ Shelley.commonTests @A @(AlonzoLEDGER A) @TestCrypto
       ++ [ CDDL.tests 50
-         , IncrementalStake.incrStakeComparisonTest (Proxy :: Proxy A)
+         , IncrementalStake.incrStakeComparisonTest (Proxy @A) (Proxy @TestCrypto)
          , ChainTrace.tests
          ]

eras/babbage/test-suite/src/Test/Cardano/Ledger/Babbage/Examples/Consensus.hs

@@ -58,11 +58,11 @@ import qualified Test.Cardano.Ledger.Mary.Examples.Consensus as MarySLE
 import qualified Test.Cardano.Ledger.Shelley.Examples.Consensus as SLE
 
 -- | ShelleyLedgerExamples for Babbage era
-ledgerExamplesBabbage :: SLE.ShelleyLedgerExamples Babbage
+ledgerExamplesBabbage :: SLE.ShelleyLedgerExamples Babbage StandardCrypto
 ledgerExamplesBabbage =
   SLE.ShelleyLedgerExamples
     { SLE.sleBlock = SLE.exampleShelleyLedgerBlock exampleTransactionInBlock
-    , SLE.sleHashHeader = SLE.exampleHashHeader (Proxy @Babbage)
+    , SLE.sleHashHeader = SLE.exampleHashHeader (Proxy @Babbage) (Proxy @StandardCrypto)
     , SLE.sleTx = exampleTransactionInBlock
     , SLE.sleApplyTxError =
         ApplyTxError $
@@ -85,7 +85,7 @@ ledgerExamplesBabbage =
       SLE.ShelleyResultExamples
         { SLE.srePParams = def
         , SLE.sreProposedPPUpdates = examplePPPU
-        , SLE.srePoolDistr = SLE.examplePoolDistr
+        , SLE.srePoolDistr = SLE.examplePoolDistr (Proxy @StandardCrypto) (Proxy @StandardCrypto)
         , SLE.sreNonMyopicRewards = SLE.exampleNonMyopicRewards
         , SLE.sreShelleyGenesis = SLE.testShelleyGenesis
         }
@@ -120,7 +120,7 @@ exampleTxBodyBabbage =
     )
     (SJust $ mkSized (eraProtVerHigh @Babbage) collateralOutput) -- collateral return
     (SJust $ Coin 8675309) -- collateral tot
-    SLE.exampleCerts -- txcerts
+    (SLE.exampleCerts (Proxy @StandardCrypto)) -- txcerts
     ( Withdrawals $
         Map.singleton
           (RewardAcnt Testnet (SLE.keyToCredential SLE.exampleStakeKey))
@@ -181,6 +181,7 @@ exampleTransactionInBlock = AlonzoTx b w (IsValid True) a
 exampleBabbageNewEpochState :: NewEpochState Babbage
 exampleBabbageNewEpochState =
   SLE.exampleNewEpochState
+    (Proxy @StandardCrypto)
     (MarySLE.exampleMultiAssetValue 1)
     emptyPParams
     (emptyPParams & ppCoinsPerUTxOByteL .~ CoinPerByte (Coin 1))

eras/babbage/test-suite/test/Test/Cardano/Ledger/Babbage/Serialisation/Tripping.hs

@@ -66,7 +66,7 @@ tests =
     , testProperty "babbage/BabbageUtxoPredFailure" $
         roundTripCborExpectation @(BabbageUtxoPredFailure Babbage)
     , testProperty "babbage/Block" $
-        roundTripAnnRangeExpectation @(Block (BHeader StandardCrypto) Babbage)
+        roundTripAnnRangeExpectation @(Block (BHeader StandardCrypto StandardCrypto) Babbage)
           (eraProtVerLow @Babbage)
           (eraProtVerHigh @Babbage)
     ]

eras/conway/test-suite/src/Test/Cardano/Ledger/Conway/Examples/Consensus.hs

@@ -72,11 +72,11 @@ import qualified Test.Cardano.Ledger.Shelley.Examples.Consensus as SLE
 -- ==============================================================
 
 -- | ShelleyLedgerExamples for Conway era
-ledgerExamplesConway :: SLE.ShelleyLedgerExamples Conway
+ledgerExamplesConway :: SLE.ShelleyLedgerExamples Conway StandardCrypto
 ledgerExamplesConway =
   SLE.ShelleyLedgerExamples
     { SLE.sleBlock = SLE.exampleShelleyLedgerBlock exampleTransactionInBlock
-    , SLE.sleHashHeader = SLE.exampleHashHeader (Proxy @Conway)
+    , SLE.sleHashHeader = SLE.exampleHashHeader (Proxy @Conway) (Proxy @StandardCrypto)
     , SLE.sleTx = exampleTransactionInBlock
     , SLE.sleApplyTxError =
         ApplyTxError $
@@ -99,7 +99,7 @@ ledgerExamplesConway =
       SLE.ShelleyResultExamples
         { SLE.srePParams = def
         , SLE.sreProposedPPUpdates = examplePPPU
-        , SLE.srePoolDistr = SLE.examplePoolDistr
+        , SLE.srePoolDistr = SLE.examplePoolDistr (Proxy @StandardCrypto) (Proxy @StandardCrypto)
         , SLE.sreNonMyopicRewards = SLE.exampleNonMyopicRewards
         , SLE.sreShelleyGenesis = SLE.testShelleyGenesis
         }
@@ -120,7 +120,7 @@ collateralOutput =
 exampleConwayCerts :: CC.Crypto c => StrictSeq (ConwayDCert c)
 exampleConwayCerts =
   StrictSeq.fromList -- TODO should I add the new certs here?
-    [ ConwayDCertPool (RegPool examplePoolParams)
+    [ ConwayDCertPool (RegPool $ examplePoolParams (Proxy @StandardCrypto))
     ]
 
 exampleTxBodyConway :: TxBody Conway
@@ -194,6 +194,7 @@ exampleTransactionInBlock = AlonzoTx b w (IsValid True) a
 exampleConwayNewEpochState :: NewEpochState Conway
 exampleConwayNewEpochState =
   SLE.exampleNewEpochState
+    (Proxy @StandardCrypto)
     (MarySLE.exampleMultiAssetValue 1)
     emptyPParams
     (emptyPParams & ppCoinsPerUTxOByteL .~ CoinPerByte (Coin 1))

eras/shelley-ma/test-suite/cardano-ledger-shelley-ma-test.cabal

@@ -53,6 +53,7 @@ library
         cardano-slotting,
         containers,
         hashable,
+        cardano-protocol-core,
         cardano-ledger-shelley-test >=1.1,
         cardano-ledger-shelley:{cardano-ledger-shelley, testlib} >=1.1,
         cardano-strict-containers,