ShelleyEraScript, AllegraEraScript

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

@@ -15,10 +15,12 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE UndecidableSuperClasses #-}
 {-# LANGUAGE ViewPatterns #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
 module Cardano.Ledger.Allegra.Scripts (
+  AllegraEraScript (..),
   Timelock (
     RequireSignature,
     RequireAllOf,
@@ -74,7 +76,7 @@ import Cardano.Ledger.MemoBytes (
   mkMemoized,
  )
 import Cardano.Ledger.SafeHash (SafeToHash)
-import Cardano.Ledger.Shelley.Scripts (nativeMultiSigTag)
+import Cardano.Ledger.Shelley.Scripts (ShelleyEraScript (..), nativeMultiSigTag)
 import qualified Cardano.Ledger.Shelley.Scripts as Shelley
 import Cardano.Slotting.Slot (SlotNo (..))
 import Control.DeepSeq (NFData (..))
@@ -130,6 +132,10 @@ data TimelockRaw era
   | TimeExpire !SlotNo -- The time it expires
   deriving (Eq, Generic, NFData)
 
+class ShelleyEraScript era => AllegraEraScript era where
+  mkTimeStart :: SlotNo -> NativeScript era
+  mkTimeExpire :: SlotNo -> NativeScript era
+
 deriving instance Era era => NoThunks (TimelockRaw era)
 
 deriving instance HashAlgorithm (HASH (EraCrypto era)) => Show (TimelockRaw era)
@@ -219,6 +225,16 @@ instance Crypto c => EraScript (AllegraEra c) where
 
   fromNativeScript = id
 
+instance Crypto c => ShelleyEraScript (AllegraEra c) where
+  mkRequireSignature = RequireSignature
+  mkRequireAllOf = RequireAllOf . Seq.fromList
+  mkRequireAnyOf = RequireAnyOf . Seq.fromList
+  mkRequireMOf n = RequireMOf n . Seq.fromList
+
+instance Crypto c => AllegraEraScript (AllegraEra c) where
+  mkTimeStart = RequireTimeStart
+  mkTimeExpire = RequireTimeExpire
+
 instance EqRaw (Timelock era) where
   eqRaw = eqTimelockRaw
 

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

@@ -60,7 +60,12 @@ module Cardano.Ledger.Alonzo.Scripts (
 where
 
 import Cardano.Ledger.Address (RewardAccount)
-import Cardano.Ledger.Allegra.Scripts (Timelock, eqTimelockRaw, translateTimelock)
+import Cardano.Ledger.Allegra.Scripts (
+  AllegraEraScript (..),
+  Timelock (..),
+  eqTimelockRaw,
+  translateTimelock,
+ )
 import Cardano.Ledger.Alonzo.Era (AlonzoEra)
 import Cardano.Ledger.Alonzo.TxCert ()
 import Cardano.Ledger.BaseTypes (ProtVer (..), kindObject)
@@ -106,14 +111,15 @@ import Cardano.Ledger.Plutus.Language (
   withSLanguage,
  )
 import Cardano.Ledger.SafeHash (SafeToHash (..))
-import Cardano.Ledger.Shelley.Scripts (nativeMultiSigTag)
+import Cardano.Ledger.Shelley.Scripts (ShelleyEraScript (..), nativeMultiSigTag)
 import Cardano.Ledger.TxIn (TxIn)
 import Control.DeepSeq (NFData (..), deepseq)
 import Control.Monad (guard)
 import Data.Aeson (ToJSON (..), Value (String), object, (.=))
 import qualified Data.ByteString as BS
 import Data.Kind (Type)
 import Data.Maybe (fromJust, isJust)
+import qualified Data.Sequence.Strict as Seq
 import Data.Typeable
 import Data.Word (Word16, Word32, Word8)
 import GHC.Generics (Generic)
@@ -147,6 +153,7 @@ class
   , Show (PlutusPurpose AsIxItem era)
   , NoThunks (PlutusPurpose AsIxItem era)
   , NFData (PlutusPurpose AsIxItem era)
+  , AllegraEraScript era
   ) =>
   AlonzoEraScript era
   where
@@ -460,6 +467,16 @@ alonzoScriptPrefixTag = \case
   TimelockScript _ -> nativeMultiSigTag -- "\x00"
   PlutusScript plutusScript -> BS.singleton (withPlutusScript plutusScript plutusLanguageTag)
 
+instance Crypto c => ShelleyEraScript (AlonzoEra c) where
+  mkRequireSignature = RequireSignature
+  mkRequireAllOf = RequireAllOf . Seq.fromList
+  mkRequireAnyOf = RequireAnyOf . Seq.fromList
+  mkRequireMOf n = RequireMOf n . Seq.fromList
+
+instance Crypto c => AllegraEraScript (AlonzoEra c) where
+  mkTimeStart = RequireTimeStart
+  mkTimeExpire = RequireTimeExpire
+
 instance Crypto c => AlonzoEraScript (AlonzoEra c) where
   newtype PlutusScript (AlonzoEra c) = AlonzoPlutusV1 (Plutus 'PlutusV1)
     deriving newtype (Eq, Ord, Show, NFData, NoThunks, SafeToHash, Generic)

eras/babbage/impl/src/Cardano/Ledger/Babbage/Scripts.hs

@@ -21,7 +21,7 @@ module Cardano.Ledger.Babbage.Scripts (
 )
 where
 
-import Cardano.Ledger.Allegra.Scripts (Timelock, translateTimelock)
+import Cardano.Ledger.Allegra.Scripts (AllegraEraScript (..), Timelock (..), translateTimelock)
 import Cardano.Ledger.Alonzo.Core
 import Cardano.Ledger.Alonzo.Scripts (
   AlonzoPlutusPurpose (..),
@@ -35,7 +35,9 @@ import Cardano.Ledger.Babbage.TxCert ()
 import Cardano.Ledger.Crypto
 import Cardano.Ledger.Plutus.Language
 import Cardano.Ledger.SafeHash (SafeToHash (..))
+import Cardano.Ledger.Shelley.Scripts (ShelleyEraScript (..))
 import Control.DeepSeq (NFData (..), rwhnf)
+import qualified Data.Sequence.Strict as Seq
 import GHC.Generics
 import NoThunks.Class (NoThunks (..))
 
@@ -105,6 +107,16 @@ instance Crypto c => AlonzoEraScript (BabbageEra c) where
     AlonzoRewarding (AsIx ix) -> AlonzoRewarding (AsIx ix)
     AlonzoCertifying (AsIx ix) -> AlonzoCertifying (AsIx ix)
 
+instance Crypto c => ShelleyEraScript (BabbageEra c) where
+  mkRequireSignature = RequireSignature
+  mkRequireAllOf = RequireAllOf . Seq.fromList
+  mkRequireAnyOf = RequireAnyOf . Seq.fromList
+  mkRequireMOf n = RequireMOf n . Seq.fromList
+
+instance Crypto c => AllegraEraScript (BabbageEra c) where
+  mkTimeStart = RequireTimeStart
+  mkTimeExpire = RequireTimeExpire
+
 instance NFData (PlutusScript (BabbageEra c)) where
   rnf = rwhnf
 instance NoThunks (PlutusScript (BabbageEra c))

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

@@ -26,7 +26,7 @@ module Cardano.Ledger.Conway.Scripts (
 where
 
 import Cardano.Ledger.Address (RewardAccount)
-import Cardano.Ledger.Allegra.Scripts (Timelock, translateTimelock)
+import Cardano.Ledger.Allegra.Scripts (AllegraEraScript (..), Timelock (..), translateTimelock)
 import Cardano.Ledger.Alonzo.Scripts (
   AlonzoPlutusPurpose (..),
   AlonzoScript (..),
@@ -52,9 +52,11 @@ import Cardano.Ledger.Crypto
 import Cardano.Ledger.Mary.Value (PolicyID)
 import Cardano.Ledger.Plutus.Language
 import Cardano.Ledger.SafeHash (SafeToHash (..))
+import Cardano.Ledger.Shelley.Scripts (ShelleyEraScript (..))
 import Cardano.Ledger.TxIn (TxIn)
 import Control.DeepSeq (NFData (..), rwhnf)
 import Data.Aeson (ToJSON (..), (.=))
+import qualified Data.Sequence.Strict as Seq
 import Data.Typeable
 import Data.Word (Word16, Word32, Word8)
 import GHC.Generics
@@ -152,6 +154,16 @@ instance Crypto c => ConwayEraScript (ConwayEra c) where
   toProposingPurpose (ConwayProposing i) = Just i
   toProposingPurpose _ = Nothing
 
+instance Crypto c => ShelleyEraScript (ConwayEra c) where
+  mkRequireSignature = RequireSignature
+  mkRequireAllOf = RequireAllOf . Seq.fromList
+  mkRequireAnyOf = RequireAnyOf . Seq.fromList
+  mkRequireMOf n = RequireMOf n . Seq.fromList
+
+instance Crypto c => AllegraEraScript (ConwayEra c) where
+  mkTimeStart = RequireTimeStart
+  mkTimeExpire = RequireTimeExpire
+
 instance NFData (PlutusScript (ConwayEra c)) where
   rnf = rwhnf
 instance NoThunks (PlutusScript (ConwayEra c))

eras/mary/impl/src/Cardano/Ledger/Mary/Scripts.hs

@@ -7,11 +7,19 @@ module Cardano.Ledger.Mary.Scripts (
 )
 where
 
-import Cardano.Ledger.Allegra.Scripts (Timelock, translateTimelock)
+import Cardano.Ledger.Allegra.Scripts (
+  AllegraEraScript (..),
+  Timelock (..),
+  translateTimelock,
+ )
 import Cardano.Ledger.Core
 import Cardano.Ledger.Crypto (Crypto)
 import Cardano.Ledger.Mary.Era (MaryEra)
-import Cardano.Ledger.Shelley.Scripts (nativeMultiSigTag)
+import Cardano.Ledger.Shelley.Scripts (
+  ShelleyEraScript (..),
+  nativeMultiSigTag,
+ )
+import qualified Data.Sequence.Strict as Seq
 
 -- | Since Timelock scripts are a strictly backwards compatible extension of
 -- MultiSig scripts, we can use the same 'scriptPrefixTag' tag here as we did
@@ -27,3 +35,13 @@ instance Crypto c => EraScript (MaryEra c) where
   getNativeScript = Just
 
   fromNativeScript = id
+
+instance Crypto c => ShelleyEraScript (MaryEra c) where
+  mkRequireSignature = RequireSignature
+  mkRequireAllOf = RequireAllOf . Seq.fromList
+  mkRequireAnyOf = RequireAnyOf . Seq.fromList
+  mkRequireMOf n = RequireMOf n . Seq.fromList
+
+instance Crypto c => AllegraEraScript (MaryEra c) where
+  mkTimeStart = RequireTimeStart
+  mkTimeExpire = RequireTimeExpire

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

@@ -13,6 +13,7 @@
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE UndecidableSuperClasses #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
 module Cardano.Ledger.Shelley.Scripts (
@@ -22,6 +23,7 @@ module Cardano.Ledger.Shelley.Scripts (
     RequireSignature,
     RequireMOf
   ),
+  ShelleyEraScript (..),
   evalMultiSig,
   validateMultiSig,
   ScriptHash (..),
@@ -91,6 +93,12 @@ data MultiSigRaw era
   deriving (Eq, Generic)
   deriving anyclass (NoThunks)
 
+class EraScript era => ShelleyEraScript era where
+  mkRequireSignature :: KeyHash 'Witness (EraCrypto era) -> NativeScript era
+  mkRequireAllOf :: [NativeScript era] -> NativeScript era
+  mkRequireAnyOf :: [NativeScript era] -> NativeScript era
+  mkRequireMOf :: Int -> [NativeScript era] -> NativeScript era
+
 deriving instance HashAlgorithm (HASH (EraCrypto era)) => Show (MultiSigRaw era)
 
 instance NFData (MultiSigRaw era)
@@ -124,6 +132,12 @@ instance Crypto c => EraScript (ShelleyEra c) where
   -- In the ShelleyEra there is only one kind of Script and its tag is "\x00"
   scriptPrefixTag _script = nativeMultiSigTag
 
+instance Crypto c => ShelleyEraScript (ShelleyEra c) where
+  mkRequireSignature = RequireSignature
+  mkRequireAllOf = RequireAllOf
+  mkRequireAnyOf = RequireAnyOf
+  mkRequireMOf = RequireMOf
+
 deriving newtype instance NFData (MultiSig era)
 
 deriving via