WIP transitioning Allegra

cabal.project

@@ -18,6 +18,7 @@ index-state: 2022-10-25T23:33:39Z
 index-state: cardano-haskell-packages 2022-11-02T15:34:17Z
 
 packages:
+  eras/allegra/impl
   eras/alonzo/impl
   eras/alonzo/test-suite
   eras/babbage/impl
@@ -30,6 +31,7 @@ packages:
   eras/byron/ledger/impl/test
   eras/byron/crypto
   eras/byron/crypto/test
+  eras/mary/impl
   eras/shelley/impl
   eras/shelley/test-suite
   eras/shelley-ma/impl

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

@@ -1,11 +1,10 @@
 cabal-version: 3.0
 
-name:                cardano-ledger-shelley-ma
+name:                cardano-ledger-allegra
 version:             0.1.0.0
-synopsis:            Shelley ledger with multiasset and time lock support.
+synopsis:            Allegra ledger era that introduces time lock support.
 description:
-  This package extends the Shelley ledger with support for
-  native tokens and timelocks.
+  This package builds upon Shelley era with support for timelocks.
 bug-reports:         https://github.com/input-output-hk/cardano-ledger/issues
 license:             Apache-2.0
 author:              IOHK
@@ -16,7 +15,7 @@ build-type:          Simple
 source-repository head
   type:     git
   location: https://github.com/input-output-hk/cardano-ledger
-  subdir:   eras/shelley-ma/impl
+  subdir:   eras/allegra/impl
 
 common base
   build-depends:      base >= 4.12 && < 4.17
@@ -37,26 +36,21 @@ library
 
   exposed-modules:
     Cardano.Ledger.Allegra
+    Cardano.Ledger.Allegra.Core
+    Cardano.Ledger.Allegra.Era
+    Cardano.Ledger.Allegra.Rules
+    Cardano.Ledger.Allegra.Timelocks
     Cardano.Ledger.Allegra.Translation
-    Cardano.Ledger.Mary
-    Cardano.Ledger.Mary.UTxO
-    Cardano.Ledger.Mary.Translation
-    Cardano.Ledger.Mary.Value
-    Cardano.Ledger.ShelleyMA
-    Cardano.Ledger.ShelleyMA.Core
-    Cardano.Ledger.ShelleyMA.Era
-    Cardano.Ledger.ShelleyMA.AuxiliaryData
-    Cardano.Ledger.ShelleyMA.Rules
-    Cardano.Ledger.ShelleyMA.Timelocks
-    Cardano.Ledger.ShelleyMA.TxBody
-    Cardano.Ledger.ShelleyMA.TxOut
-    Cardano.Ledger.ShelleyMA.Tx
-    Cardano.Ledger.ShelleyMA.TxWits
+    Cardano.Ledger.Allegra.Tx
+    Cardano.Ledger.Allegra.TxAuxData
+    Cardano.Ledger.Allegra.TxBody
+    Cardano.Ledger.Allegra.TxOut
+    Cardano.Ledger.Allegra.TxWits
 
   other-modules:
     Cardano.Ledger.Allegra.UTxO
-    Cardano.Ledger.ShelleyMA.Rules.Utxo
-    Cardano.Ledger.ShelleyMA.Rules.Utxow
+    Cardano.Ledger.Allegra.Rules.Utxo
+    Cardano.Ledger.Allegra.Rules.Utxow
 
   build-depends:
     bytestring,

eras/allegra/impl/src/Cardano/Ledger/Allegra/Core.hs

@@ -1,26 +1,16 @@
 {-# LANGUAGE FlexibleContexts #-}
 
-module Cardano.Ledger.ShelleyMA.Core
-  ( ShelleyMAEraTxBody (..),
+module Cardano.Ledger.Allegra.Core
+  ( AllegraEraTxBody (..),
     module Cardano.Ledger.Shelley.Core,
   )
 where
 
-import Cardano.Ledger.Mary.Value (MultiAsset (..))
 import Cardano.Ledger.Shelley.Core
-import Cardano.Ledger.ShelleyMA.Timelocks (ValidityInterval (..))
+import Cardano.Ledger.Allegra.Timelocks (ValidityInterval (..))
 import Cardano.Ledger.Val (DecodeMint, EncodeMint)
 import Data.Set (Set)
 import Lens.Micro (Lens', SimpleGetter)
 
-class
-  (ShelleyEraTxBody era, EncodeMint (Value era), DecodeMint (Value era)) =>
-  ShelleyMAEraTxBody era
-  where
+class ShelleyEraTxBody era => AllegraEraTxBody era where
   vldtTxBodyL :: Lens' (TxBody era) ValidityInterval
-
-  mintTxBodyL :: Lens' (TxBody era) (MultiAsset (EraCrypto era))
-
-  mintValueTxBodyF :: SimpleGetter (TxBody era) (Value era)
-
-  mintedTxBodyF :: SimpleGetter (TxBody era) (Set (ScriptHash (EraCrypto era)))

eras/allegra/impl/src/Cardano/Ledger/Allegra/Era.hs

@@ -6,23 +6,16 @@
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
 
-module Cardano.Ledger.ShelleyMA.Era
-  ( ShelleyMAEra,
-    MAClass (..),
-    MaryOrAllegra (..),
-    ShelleyMAUTXO,
-    ShelleyMAUTXOW,
-    MaryEra,
-    AllegraEra,
+module Cardano.Ledger.Allegra.Era
+  ( AllegraEra,
+    AllegraUTXO,
+    AllegraUTXOW,
   )
 where
 
-import Cardano.Ledger.Binary (FromCBOR (..), MaxVersion, MinVersion, ToCBOR (..))
 import Cardano.Ledger.Coin (Coin)
-import Cardano.Ledger.Compactible (CompactForm, Compactible)
-import Cardano.Ledger.Core
+import Cardano.Ledger.Core (Era (EraCrypto, ProtVerLow), EraPParams (..), EraRule, Value)
 import Cardano.Ledger.Crypto as CC (Crypto)
-import Cardano.Ledger.Mary.Value (MaryValue (..), MultiAsset (..), policies, policyID)
 import qualified Cardano.Ledger.Shelley.API as API
 import Cardano.Ledger.Shelley.PParams (ShelleyPParams, ShelleyPParamsUpdate, updatePParams)
 import Cardano.Ledger.Shelley.Rules
@@ -35,130 +28,70 @@ import Cardano.Ledger.Shelley.Rules
     ShelleyTICKF,
     ShelleyUPEC,
   )
-import Cardano.Ledger.Val (DecodeMint, DecodeNonNegative, EncodeMint, Val, zero)
-import Control.DeepSeq (NFData (..))
-import Data.Kind (Type)
-import Data.Set as Set (Set, empty, map)
-import Data.Typeable (Typeable)
-import GHC.TypeLits
-import NoThunks.Class (NoThunks)
-
-type MaryEra = ShelleyMAEra 'Mary
-
-type AllegraEra = ShelleyMAEra 'Allegra
-
--- | The Shelley Mary/Allegra eras
---   The uninhabited type that indexes both the Mary and Allegra Eras.
-data ShelleyMAEra (ma :: MaryOrAllegra) c
-
--- | Both eras are implemented within the same codebase, matching the formal
--- specification. They differ only in the @value@ type. Due to some annoying
--- issues with 'Coin' and 'Value' being of different kinds, we don't parametrise
--- over the value but instead over a closed kind 'MaryOrAllegra'. But this
--- should be transparent to the user.
-data MaryOrAllegra = Mary | Allegra
-
--- | The MAClass provides a method and a type, which implement the differences
---   between the Mary and Allegra instances
-class
-  ( Typeable ma,
-    CC.Crypto c,
-    DecodeNonNegative (MAValue ma c),
-    Compactible (MAValue ma c),
-    Eq (CompactForm (MAValue ma c)),
-    NFData (MAValue ma c),
-    Show (MAValue ma c),
-    Val (MAValue ma c),
-    Eq (MAValue ma c),
-    FromCBOR (MAValue ma c),
-    ToCBOR (MAValue ma c),
-    EncodeMint (MAValue ma c),
-    DecodeMint (MAValue ma c),
-    NoThunks (MAValue ma c),
-    KnownNat (MAProtVer ma),
-    MinVersion <= MAProtVer ma,
-    MAProtVer ma <= MaxVersion
-  ) =>
-  MAClass (ma :: MaryOrAllegra) c
-  where
-  type MAValue (ma :: MaryOrAllegra) c :: Type
-  getScriptHash :: proxy ma -> MultiAsset c -> Set.Set (ScriptHash c)
-  promoteMultiAsset :: proxy ma -> MultiAsset c -> Value (ShelleyMAEra ma c)
-
-instance CC.Crypto c => MAClass 'Mary c where
-  type MAValue 'Mary c = MaryValue c
-  getScriptHash _ x = Set.map policyID (policies x)
-  promoteMultiAsset _ ma = MaryValue 0 ma
-
-instance CC.Crypto c => MAClass 'Allegra c where
-  type MAValue 'Allegra c = Coin
-  getScriptHash _ _ = Set.empty
-  promoteMultiAsset _ _ = zero
-
-instance MAClass ma c => Era (ShelleyMAEra ma c) where
-  type EraCrypto (ShelleyMAEra ma c) = c
-  type ProtVerLow (ShelleyMAEra ma c) = MAProtVer ma
-
-type family MAProtVer (ma :: MaryOrAllegra) :: Nat where
-  MAProtVer 'Allegra = 3
-  MAProtVer 'Mary = 4
+
+-- | The Allegra era
+data AllegraEra c
+
+instance Crypto c => Era (AllegraEra c) where
+  type EraCrypto (AllegraEra c) = c
+  type ProtVerLow (AllegraEra c) = 3
 
 --------------------------------------------------------------------------------
 -- Core instances
 --------------------------------------------------------------------------------
 
-type instance Value (ShelleyMAEra ma c) = MAValue ma c
+type instance Value (AllegraEra _) = Coin
 
-instance MAClass ma c => EraPParams (ShelleyMAEra ma c) where
-  type PParams (ShelleyMAEra ma c) = ShelleyPParams (ShelleyMAEra ma c)
-  type PParamsUpdate (ShelleyMAEra ma c) = ShelleyPParamsUpdate (ShelleyMAEra ma c)
+instance Crypto c => EraPParams (AllegraEra c) where
+  type PParams (AllegraEra c) = ShelleyPParams (AllegraEra c)
+  type PParamsUpdate (AllegraEra c) = ShelleyPParamsUpdate (AllegraEra c)
 
   applyPPUpdates = updatePParams
 
 -- These rules are all inherited from Shelley
 
-type instance EraRule "BBODY" (ShelleyMAEra ma c) = ShelleyBBODY (ShelleyMAEra ma c)
+type instance EraRule "BBODY" (AllegraEra c) = ShelleyBBODY (AllegraEra c)
 
-type instance EraRule "DELEG" (ShelleyMAEra ma c) = API.ShelleyDELEG (ShelleyMAEra ma c)
+type instance EraRule "DELEG" (AllegraEra c) = API.ShelleyDELEG (AllegraEra c)
 
-type instance EraRule "DELEGS" (ShelleyMAEra ma c) = API.ShelleyDELEGS (ShelleyMAEra ma c)
+type instance EraRule "DELEGS" (AllegraEra c) = API.ShelleyDELEGS (AllegraEra c)
 
-type instance EraRule "DELPL" (ShelleyMAEra ma c) = API.ShelleyDELPL (ShelleyMAEra ma c)
+type instance EraRule "DELPL" (AllegraEra c) = API.ShelleyDELPL (AllegraEra c)
 
-type instance EraRule "EPOCH" (ShelleyMAEra ma c) = ShelleyEPOCH (ShelleyMAEra ma c)
+type instance EraRule "EPOCH" (AllegraEra c) = ShelleyEPOCH (AllegraEra c)
 
-type instance EraRule "LEDGER" (ShelleyMAEra ma c) = API.ShelleyLEDGER (ShelleyMAEra ma c)
+type instance EraRule "LEDGER" (AllegraEra c) = API.ShelleyLEDGER (AllegraEra c)
 
-type instance EraRule "LEDGERS" (ShelleyMAEra ma c) = API.ShelleyLEDGERS (ShelleyMAEra ma c)
+type instance EraRule "LEDGERS" (AllegraEra c) = API.ShelleyLEDGERS (AllegraEra c)
 
-type instance EraRule "MIR" (ShelleyMAEra ma c) = ShelleyMIR (ShelleyMAEra ma c)
+type instance EraRule "MIR" (AllegraEra c) = ShelleyMIR (AllegraEra c)
 
-type instance EraRule "NEWEPOCH" (ShelleyMAEra ma c) = API.ShelleyNEWEPOCH (ShelleyMAEra ma c)
+type instance EraRule "NEWEPOCH" (AllegraEra c) = API.ShelleyNEWEPOCH (AllegraEra c)
 
-type instance EraRule "NEWPP" (ShelleyMAEra ma c) = ShelleyNEWPP (ShelleyMAEra ma c)
+type instance EraRule "NEWPP" (AllegraEra c) = ShelleyNEWPP (AllegraEra c)
 
-type instance EraRule "POOL" (ShelleyMAEra ma c) = API.ShelleyPOOL (ShelleyMAEra ma c)
+type instance EraRule "POOL" (AllegraEra c) = API.ShelleyPOOL (AllegraEra c)
 
-type instance EraRule "POOLREAP" (ShelleyMAEra ma c) = API.ShelleyPOOLREAP (ShelleyMAEra ma c)
+type instance EraRule "POOLREAP" (AllegraEra c) = API.ShelleyPOOLREAP (AllegraEra c)
 
-type instance EraRule "PPUP" (ShelleyMAEra ma c) = API.ShelleyPPUP (ShelleyMAEra ma c)
+type instance EraRule "PPUP" (AllegraEra c) = API.ShelleyPPUP (AllegraEra c)
 
-type instance EraRule "RUPD" (ShelleyMAEra ma c) = ShelleyRUPD (ShelleyMAEra ma c)
+type instance EraRule "RUPD" (AllegraEra c) = ShelleyRUPD (AllegraEra c)
 
-type instance EraRule "SNAP" (ShelleyMAEra ma c) = ShelleySNAP (ShelleyMAEra ma c)
+type instance EraRule "SNAP" (AllegraEra c) = ShelleySNAP (AllegraEra c)
 
-type instance EraRule "TICK" (ShelleyMAEra ma c) = API.ShelleyTICK (ShelleyMAEra ma c)
+type instance EraRule "TICK" (AllegraEra c) = API.ShelleyTICK (AllegraEra c)
 
-type instance EraRule "TICKF" (ShelleyMAEra ma c) = ShelleyTICKF (ShelleyMAEra ma c)
+type instance EraRule "TICKF" (AllegraEra c) = ShelleyTICKF (AllegraEra c)
 
-type instance EraRule "UPEC" (ShelleyMAEra ma c) = ShelleyUPEC (ShelleyMAEra ma c)
+type instance EraRule "UPEC" (AllegraEra c) = ShelleyUPEC (AllegraEra c)
 
--- These rules are defined anew in the ShelleyMA era(s)
+-- These rules are defined anew in the Allegra era(s)
 
-data ShelleyMAUTXO era
+data AllegraUTXO era
 
-type instance EraRule "UTXO" (ShelleyMAEra ma c) = ShelleyMAUTXO (ShelleyMAEra ma c)
+type instance EraRule "UTXO" (AllegraEra c) = AllegraUTXO (AllegraEra c)
 
-data ShelleyMAUTXOW era
+data AllegraUTXOW era
 
-type instance EraRule "UTXOW" (ShelleyMAEra ma c) = ShelleyMAUTXOW (ShelleyMAEra ma c)
+type instance EraRule "UTXOW" (AllegraEra c) = AllegraUTXOW (AllegraEra c)

eras/allegra/impl/src/Cardano/Ledger/Allegra/Timelocks.hs

@@ -17,7 +17,7 @@
 {-# LANGUAGE ViewPatterns #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
-module Cardano.Ledger.ShelleyMA.Timelocks
+module Cardano.Ledger.Allegra.Timelocks
   ( Timelock
       ( RequireSignature,
         RequireAllOf,
@@ -40,6 +40,7 @@ module Cardano.Ledger.ShelleyMA.Timelocks
 where
 
 import Cardano.Crypto.Hash.Class (HashAlgorithm)
+import Cardano.Ledger.Allegra.Era (AllegraEra)
 import Cardano.Ledger.BaseTypes (StrictMaybe (SJust, SNothing))
 import Cardano.Ledger.Binary
   ( Annotator (..),
@@ -70,7 +71,6 @@ import Cardano.Ledger.MemoBytes
   )
 import Cardano.Ledger.SafeHash (SafeToHash)
 import Cardano.Ledger.Shelley.Scripts (nativeMultiSigTag)
-import Cardano.Ledger.ShelleyMA.Era (MAClass, ShelleyMAEra)
 import Cardano.Slotting.Slot (SlotNo (..))
 import Control.DeepSeq (NFData (..))
 import Data.ByteString.Lazy (fromStrict)
@@ -183,13 +183,13 @@ instance Memoized Timelock where
 
 deriving instance HashAlgorithm (HASH (EraCrypto era)) => Show (Timelock era)
 
-type instance SomeScript 'PhaseOne (ShelleyMAEra ma c) = Timelock (ShelleyMAEra ma c)
+type instance SomeScript 'PhaseOne (AllegraEra ma c) = Timelock (AllegraEra ma c)
 
 -- | Since Timelock scripts are a strictly backwards compatible extension of
 -- MultiSig scripts, we can use the same 'scriptPrefixTag' tag here as we did
 -- for the ValidateScript instance in Multisig
-instance MAClass ma c => EraScript (ShelleyMAEra ma c) where
-  type Script (ShelleyMAEra ma c) = Timelock (ShelleyMAEra ma c)
+instance Crypto c => EraScript (AllegraEra c) where
+  type Script (AllegraEra c) = Timelock (AllegraEra c)
   scriptPrefixTag _script = nativeMultiSigTag -- "\x00"
   phaseScript PhaseOneRep timelock = Just (Phase1Script timelock)
   phaseScript PhaseTwoRep _ = Nothing