Added Mary and Allegra instances

IntersectMBO · Feb 26, 2021 · 3865618 · 3865618
1 parent 2126f32
commit 3865618
Showing 1 changed file with 113 additions and 48 deletions.
diff --git a/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxow.hs b/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxow.hs
@@ -61,13 +61,7 @@ import Shelley.Spec.Ledger.UTxO
   )
 
 -- Extra imports
-import Cardano.Ledger.Shelley(ShelleyEra)
-import Shelley.Spec.Ledger.Tx as Shelley(Tx,TxBody,TxOut,WitnessSet)
 
-import qualified Shelley.Spec.Ledger.Tx as Mary(Tx(Tx'))
-import qualified Shelley.Spec.Ledger.Tx as Mary(TxBody)
-import qualified Cardano.Ledger.Mary.Value as Mary(Value)
-import qualified Cardano.Ledger.Mary.Value as Alonzo(Value)
 
 import Shelley.Spec.Ledger.UTxO(UTxO(..),txinLookup,verifyWitVKey)
 import qualified Data.Sequence as Seq (filter)
@@ -102,19 +96,48 @@ import Shelley.Spec.Ledger.TxBody(TxOut(TxOutCompact),witKeyHash,DCert(..),PoolP
 import Shelley.Spec.Ledger.CompactAddr( decompactAddr )
 import qualified Cardano.Ledger.Crypto as CC(Crypto)
 import Cardano.Ledger.SafeHash (HashAnnotated, extractHash, hashAnnotated)
+import Cardano.Ledger.Compactible(Compactible)
+import Data.Typeable
+import NoThunks.Class(NoThunks)
 
+-- ========================================
+
+import Cardano.Ledger.Shelley(ShelleyEra)
+import Shelley.Spec.Ledger.Tx as Shelley(Tx,TxBody,TxOut,WitnessSet)
+
+
+import Cardano.Ledger.ShelleyMA(ShelleyMAEra, MaryOrAllegra(Mary,Allegra), MAValue)
+import qualified Shelley.Spec.Ledger.Tx as MA(Tx(Tx'))
+import qualified Cardano.Ledger.ShelleyMA.TxBody as MA(TxBody)
+import qualified Cardano.Ledger.ShelleyMA.Timelocks as MA(Timelock)
+import qualified Cardano.Ledger.Mary.Value as MA(Value)
+
+
+import Cardano.Ledger.Alonzo(AlonzoEra)
 import qualified Cardano.Ledger.Alonzo.TxBody as Alonzo(TxBody,TxOut(..))
 import qualified Cardano.Ledger.Alonzo.Tx as Alonzo(Tx(..),body,wits,TxRaw(..))
 import qualified Cardano.Ledger.Alonzo.TxWitness as Alonzo(TxWitness,witsFromTxWitness,txwitsVKey,txwitsBoot,txscripts)
 import qualified Cardano.Ledger.ShelleyMA.AuxiliaryData as Alonzo(AuxiliaryData)
 import qualified Cardano.Ledger.Alonzo.Scripts as Alonzo(Script)
+import qualified Cardano.Ledger.Mary.Value as Alonzo(Value)
+
+-- ============================================
+
 import Cardano.Ledger.Alonzo.TxBody(txcerts,txwdrls,txUpdates,txADhash,txmint,txinputs)
-import Cardano.Ledger.Alonzo(AlonzoEra)
 
--- ====================================================
 
 
--- ==========================================================
+-- Crypto imports
+import Cardano.Crypto.DSIGN (Ed25519DSIGN, MockDSIGN)
+import Cardano.Crypto.Hash (Blake2b_224, Blake2b_256, MD5Prefix)
+import Cardano.Crypto.KES (MockKES, Sum6KES)
+import Cardano.Crypto.VRF.Praos
+import qualified Cardano.Ledger.Crypto as CryptoClass
+import Shelley.Spec.Ledger.API (PraosCrypto)
+import Test.Cardano.Crypto.VRF.Fake (FakeVRF)
+
+-- ====================================================
+-- Oldstyle just for comparison
 
 -- | We want to reuse the same rules for Mary and Allegra. This however relies
 -- on being able to get a set of 'PolicyID's from the value. Since a 'Coin' has
@@ -131,44 +154,8 @@ instance GetPolicies Coin crypto where
 instance GetPolicies (Value crypto) crypto where
   getPolicies = policies
 
-
-scriptsNeeded utxo tx = undefined
-{-
--- | Computes the set of script hashes required to unlock the transaction inputs
--- and the withdrawals.
-scriptsNeeded ::
-  ( UsesScript era,
-    UsesTxOut era,
-    UsesTxBody era,
-    UsesAuxiliary era,
-    GetPolicies (Core.Value era) (Crypto era),
-    HasField "certs" (Core.TxBody era) (StrictSeq (DCert (Crypto era))),
-    HasField "wdrls" (Core.TxBody era) (Wdrl (Crypto era)),
-    HasField "inputs" (Core.TxBody era) (Set (TxIn (Crypto era))),
-    HasField "mint" (Core.TxBody era) (Core.Value era)
-  ) =>
-  UTxO era ->
-  Tx era ->
-  Set (ScriptHash (Crypto era))
-scriptsNeeded u tx =
-  Set.fromList (Map.elems $ Map.mapMaybe (getScriptHash . (getField @"address")) u'')
-    `Set.union` Set.fromList
-      ( Maybe.mapMaybe (scriptCred . getRwdCred) $
-          Map.keys withdrawals
-      )
-    `Set.union` Set.fromList
-      ( Maybe.mapMaybe
-          scriptStakeCred
-          (filter requiresVKeyWitness certificates)
-      )
-    `Set.union` (policyID `Set.map` (getPolicies $ getField @"mint" txb))
-  where
-    txb = _body tx
-    withdrawals = unWdrl $ getField @"wdrls" txb
-    u'' = eval ((txinsScript (getField @"inputs" $ _body tx) u) ◁ u)
-    certificates = (toList . getField @"certs") txb
--}
-
+scriptsNeeded:: UTxO era -> Tx era -> Set (ScriptHash (Crypto era))
+scriptsNeeded utx0 tx = undefined
 --------------------------------------------------------------------------------
 -- UTXOW STS
 --------------------------------------------------------------------------------
@@ -236,6 +223,7 @@ instance
 
 
 -- ================================================================
+-- New Style
 -- ================================================================
 
 
@@ -347,12 +335,17 @@ class ( ValidateScript era,
     wdrlsBody  :: body era -> Wdrl (Crypto era)
     certsBody  :: body era -> StrictSeq (DCert (Crypto era))
     inputsBody :: body era -> Set (TxIn (Crypto era))
-    mintBody   :: body era -> Mary.Value (Crypto era)
+    mintBody   :: body era -> MA.Value (Crypto era)
     adHashBody :: body era -> StrictMaybe (AuxiliaryDataHash (Crypto era))
     addressOut :: txout era -> Addr (Crypto era)
     validateScript2 :: Core.Script era -> tx era -> Bool
 
+
+type Shelley = ShelleyEra StandardCrypto
+type Alonzo = AlonzoEra StandardCrypto
+
 -- =========== Shelley Instance ===============
+
 instance CC.Crypto c => CoreUtxow (ShelleyEra c) Shelley.Tx Shelley.TxBody Shelley.WitnessSet Shelley.TxOut where
    bodyTx (Tx' body _wit _meta _) = body
    witTx (Tx' _body wit _meta _) = wit
@@ -368,6 +361,41 @@ instance CC.Crypto c => CoreUtxow (ShelleyEra c) Shelley.Tx Shelley.TxBody Shell
    addressOut (TxOutCompact ca _) = decompactAddr ca
    validateScript2 = validateScript
 
+-- =========== Mary Instance ===============
+
+instance CC.Crypto c => CoreUtxow (ShelleyMAEra Mary c) Shelley.Tx MA.TxBody Shelley.WitnessSet Shelley.TxOut where
+   bodyTx (Tx' body _wit _meta _) = body
+   witTx (Tx' _body wit _meta _) = wit
+   addrWit x = addrWitsX x
+   bootWit x = bootWitsX x
+   scriptWit x = scriptWitsX x
+   updateBody x = getField @"update" x
+   wdrlsBody x = getField @"wdrls" x
+   certsBody x = getField @"certs" x
+   inputsBody x = getField @"inputs" x
+   mintBody x = mempty
+   adHashBody x = getField @"adHash" x
+   addressOut (TxOutCompact ca _) = decompactAddr ca
+   validateScript2 = validateScript
+
+-- =========== Allegra Instance ===============
+
+instance CC.Crypto c => CoreUtxow (ShelleyMAEra Allegra c) Shelley.Tx MA.TxBody Shelley.WitnessSet Shelley.TxOut where
+   bodyTx (Tx' body _wit _meta _) = body
+   witTx (Tx' _body wit _meta _) = wit
+   addrWit x = addrWitsX x
+   bootWit x = bootWitsX x
+   scriptWit x = scriptWitsX x
+   updateBody x = getField @"update" x
+   wdrlsBody x = getField @"wdrls" x
+   certsBody x = getField @"certs" x
+   inputsBody x = getField @"inputs" x
+   mintBody x = mempty
+   adHashBody x = getField @"adHash" x
+   addressOut (TxOutCompact ca _) = decompactAddr ca
+   validateScript2 = validateScript
+
+
 -- ============ Alonzo instance ===============
 
 type instance Core.TxOut(AlonzoEra c) = Alonzo.TxOut (AlonzoEra c)
@@ -549,3 +577,40 @@ txwitsScript2 ::forall era tx body wit txout.
   tx era ->
   Map.Map (ScriptHash (Crypto era)) (Core.Script era)
 txwitsScript2 = scriptWit . witTx
+
+-- ========================================================
+{-
+-- ByteString imports
+import Data.ByteString.Short (ShortByteString,toShort)
+import Data.ByteString(ByteString)
+import Data.String(fromString)
+
+-- Testing imports
+import Test.Tasty
+import Test.Tasty.HUnit
+import Data.Proxy
+-}
+
+-- =======================================================
+
+data TestCrypto
+
+instance CryptoClass.Crypto TestCrypto where
+  type HASH TestCrypto = MD5Prefix 10
+  type ADDRHASH TestCrypto = MD5Prefix 8
+  type DSIGN TestCrypto = MockDSIGN
+  type KES TestCrypto = MockKES 10
+  type VRF TestCrypto = FakeVRF
+
+instance PraosCrypto TestCrypto
+
+data StandardCrypto
+
+instance CryptoClass.Crypto StandardCrypto where
+  type DSIGN StandardCrypto = Ed25519DSIGN
+  type KES StandardCrypto = Sum6KES Ed25519DSIGN Blake2b_256
+  type VRF StandardCrypto = PraosVRF
+  type HASH StandardCrypto = Blake2b_256
+  type ADDRHASH StandardCrypto = Blake2b_224
+
+instance PraosCrypto StandardCrypto