{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableSuperClasses #-}

module Test.Cardano.Ledger.Generic.Scriptic where

import Cardano.Ledger.Allegra.Scripts (
  pattern RequireTimeExpire,
  pattern RequireTimeStart,
 )
import Cardano.Ledger.Core
import Cardano.Ledger.Crypto (Crypto)
import Cardano.Ledger.Keys (KeyHash, KeyRole (..))
import Cardano.Ledger.Mary.Value (AssetName (..), MultiAsset (..), PolicyID (..))
import Cardano.Ledger.Plutus.Language (Language (..))
import Cardano.Ledger.Shelley.Scripts (
  pattern RequireAllOf,
  pattern RequireAnyOf,
  pattern RequireMOf,
  pattern RequireSignature,
 )
import Cardano.Slotting.Slot (SlotNo (..))
import qualified Data.Map.Strict as Map
import qualified Data.Sequence.Strict as Seq (fromList)
import Numeric.Natural (Natural)
import Test.Cardano.Ledger.Alonzo.Arbitrary (alwaysFails, alwaysSucceeds)
import Test.Cardano.Ledger.Generic.Indexed (theKeyHash)
import Test.Cardano.Ledger.Generic.Proof

-- =============================================
-- Making era parameterized Scripts

theSlot :: Int -> SlotNo
theSlot :: Int -> SlotNo
theSlot Int
n = Word64 -> SlotNo
SlotNo (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)

class (EraScript era, Show (Script era)) => Scriptic era where
  always :: Natural -> Proof era -> Script era
  alwaysAlt :: Natural -> Proof era -> Script era
  never :: Natural -> Proof era -> Script era
  require :: KeyHash 'Witness (EraCrypto era) -> Proof era -> NativeScript era
  allOf :: [Proof era -> NativeScript era] -> Proof era -> NativeScript era
  anyOf :: [Proof era -> NativeScript era] -> Proof era -> NativeScript era
  mOf :: Int -> [Proof era -> NativeScript era] -> Proof era -> NativeScript era

class Scriptic era => PostShelley era where
  before :: Int -> Proof era -> NativeScript era
  after :: Int -> Proof era -> NativeScript era

class HasTokens era where
  forge :: Integer -> Script era -> MultiAsset (EraCrypto era)

instance Crypto c => Scriptic (ShelleyEra c) where
  never :: Natural -> Proof (ShelleyEra c) -> Script (ShelleyEra c)
never Natural
_ Proof (ShelleyEra c)
Shelley = forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAnyOf forall a. Monoid a => a
mempty -- always False
  always :: Natural -> Proof (ShelleyEra c) -> Script (ShelleyEra c)
always Natural
_ Proof (ShelleyEra c)
Shelley = forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAllOf forall a. Monoid a => a
mempty -- always True
  alwaysAlt :: Natural -> Proof (ShelleyEra c) -> Script (ShelleyEra c)
alwaysAlt Natural
_ Proof (ShelleyEra c)
Shelley = forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAllOf forall a. Monoid a => a
mempty -- always True
  require :: KeyHash 'Witness (EraCrypto (ShelleyEra c))
-> Proof (ShelleyEra c) -> NativeScript (ShelleyEra c)
require KeyHash 'Witness (EraCrypto (ShelleyEra c))
key Proof (ShelleyEra c)
Shelley = forall era.
ShelleyEraScript era =>
KeyHash 'Witness (EraCrypto era) -> NativeScript era
RequireSignature KeyHash 'Witness (EraCrypto (ShelleyEra c))
key
  allOf :: [Proof (ShelleyEra c) -> NativeScript (ShelleyEra c)]
-> Proof (ShelleyEra c) -> NativeScript (ShelleyEra c)
allOf [Proof (ShelleyEra c) -> NativeScript (ShelleyEra c)]
xs Proof (ShelleyEra c)
Shelley = forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAllOf (forall a. [a] -> StrictSeq a
Seq.fromList (forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> a -> b
$ Proof (ShelleyEra StandardCrypto)
Shelley) [Proof (ShelleyEra c) -> NativeScript (ShelleyEra c)]
xs))
  anyOf :: [Proof (ShelleyEra c) -> NativeScript (ShelleyEra c)]
-> Proof (ShelleyEra c) -> NativeScript (ShelleyEra c)
anyOf [Proof (ShelleyEra c) -> NativeScript (ShelleyEra c)]
xs Proof (ShelleyEra c)
Shelley = forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAnyOf (forall a. [a] -> StrictSeq a
Seq.fromList (forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> a -> b
$ Proof (ShelleyEra StandardCrypto)
Shelley) [Proof (ShelleyEra c) -> NativeScript (ShelleyEra c)]
xs))
  mOf :: Int
-> [Proof (ShelleyEra c) -> NativeScript (ShelleyEra c)]
-> Proof (ShelleyEra c)
-> NativeScript (ShelleyEra c)
mOf Int
n [Proof (ShelleyEra c) -> NativeScript (ShelleyEra c)]
xs Proof (ShelleyEra c)
Shelley = forall era.
ShelleyEraScript era =>
Int -> StrictSeq (NativeScript era) -> NativeScript era
RequireMOf Int
n (forall a. [a] -> StrictSeq a
Seq.fromList (forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> a -> b
$ Proof (ShelleyEra StandardCrypto)
Shelley) [Proof (ShelleyEra c) -> NativeScript (ShelleyEra c)]
xs))

-- Make Scripts in AllegraEra

instance Crypto c => Scriptic (AllegraEra c) where
  never :: Natural -> Proof (AllegraEra c) -> Script (AllegraEra c)
never Natural
_ Proof (AllegraEra c)
Allegra = forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAnyOf forall a. Monoid a => a
mempty -- always False
  always :: Natural -> Proof (AllegraEra c) -> Script (AllegraEra c)
always Natural
_ Proof (AllegraEra c)
Allegra = forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAllOf forall a. Monoid a => a
mempty -- always True
  alwaysAlt :: Natural -> Proof (AllegraEra c) -> Script (AllegraEra c)
alwaysAlt Natural
_ Proof (AllegraEra c)
Allegra = forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAllOf forall a. Monoid a => a
mempty -- always True
  require :: KeyHash 'Witness (EraCrypto (AllegraEra c))
-> Proof (AllegraEra c) -> NativeScript (AllegraEra c)
require KeyHash 'Witness (EraCrypto (AllegraEra c))
key Proof (AllegraEra c)
Allegra = forall era.
ShelleyEraScript era =>
KeyHash 'Witness (EraCrypto era) -> NativeScript era
RequireSignature KeyHash 'Witness (EraCrypto (AllegraEra c))
key
  allOf :: [Proof (AllegraEra c) -> NativeScript (AllegraEra c)]
-> Proof (AllegraEra c) -> NativeScript (AllegraEra c)
allOf [Proof (AllegraEra c) -> NativeScript (AllegraEra c)]
xs Proof (AllegraEra c)
proof = forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAllOf (forall a. [a] -> StrictSeq a
Seq.fromList (forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> a -> b
$ Proof (AllegraEra c)
proof) [Proof (AllegraEra c) -> NativeScript (AllegraEra c)]
xs))
  anyOf :: [Proof (AllegraEra c) -> NativeScript (AllegraEra c)]
-> Proof (AllegraEra c) -> NativeScript (AllegraEra c)
anyOf [Proof (AllegraEra c) -> NativeScript (AllegraEra c)]
xs Proof (AllegraEra c)
proof = forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAnyOf (forall a. [a] -> StrictSeq a
Seq.fromList (forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> a -> b
$ Proof (AllegraEra c)
proof) [Proof (AllegraEra c) -> NativeScript (AllegraEra c)]
xs))
  mOf :: Int
-> [Proof (AllegraEra c) -> NativeScript (AllegraEra c)]
-> Proof (AllegraEra c)
-> NativeScript (AllegraEra c)
mOf Int
n [Proof (AllegraEra c) -> NativeScript (AllegraEra c)]
xs Proof (AllegraEra c)
proof = forall era.
ShelleyEraScript era =>
Int -> StrictSeq (NativeScript era) -> NativeScript era
RequireMOf Int
n (forall a. [a] -> StrictSeq a
Seq.fromList (forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> a -> b
$ Proof (AllegraEra c)
proof) [Proof (AllegraEra c) -> NativeScript (AllegraEra c)]
xs))

instance Crypto c => PostShelley (AllegraEra c) where
  before :: Int -> Proof (AllegraEra c) -> NativeScript (AllegraEra c)
before Int
n Proof (AllegraEra c)
Allegra = forall era. AllegraEraScript era => SlotNo -> NativeScript era
RequireTimeStart (Int -> SlotNo
theSlot Int
n)
  after :: Int -> Proof (AllegraEra c) -> NativeScript (AllegraEra c)
after Int
n Proof (AllegraEra c)
Allegra = forall era. AllegraEraScript era => SlotNo -> NativeScript era
RequireTimeExpire (Int -> SlotNo
theSlot Int
n)

-- Make Scripts in Mary era

instance Crypto c => Scriptic (MaryEra c) where
  never :: Natural -> Proof (MaryEra c) -> Script (MaryEra c)
never Natural
_ Proof (MaryEra c)
Mary = forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAnyOf forall a. Monoid a => a
mempty -- always False
  always :: Natural -> Proof (MaryEra c) -> Script (MaryEra c)
always Natural
_ Proof (MaryEra c)
Mary = forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAllOf forall a. Monoid a => a
mempty -- always True
  alwaysAlt :: Natural -> Proof (MaryEra c) -> Script (MaryEra c)
alwaysAlt Natural
_ Proof (MaryEra c)
Mary = forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAllOf forall a. Monoid a => a
mempty -- always True
  require :: KeyHash 'Witness (EraCrypto (MaryEra c))
-> Proof (MaryEra c) -> NativeScript (MaryEra c)
require KeyHash 'Witness (EraCrypto (MaryEra c))
key Proof (MaryEra c)
Mary = forall era.
ShelleyEraScript era =>
KeyHash 'Witness (EraCrypto era) -> NativeScript era
RequireSignature KeyHash 'Witness (EraCrypto (MaryEra c))
key
  allOf :: [Proof (MaryEra c) -> NativeScript (MaryEra c)]
-> Proof (MaryEra c) -> NativeScript (MaryEra c)
allOf [Proof (MaryEra c) -> NativeScript (MaryEra c)]
xs Proof (MaryEra c)
proof = forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAllOf (forall a. [a] -> StrictSeq a
Seq.fromList (forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> a -> b
$ Proof (MaryEra c)
proof) [Proof (MaryEra c) -> NativeScript (MaryEra c)]
xs))
  anyOf :: [Proof (MaryEra c) -> NativeScript (MaryEra c)]
-> Proof (MaryEra c) -> NativeScript (MaryEra c)
anyOf [Proof (MaryEra c) -> NativeScript (MaryEra c)]
xs Proof (MaryEra c)
proof = forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAnyOf (forall a. [a] -> StrictSeq a
Seq.fromList (forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> a -> b
$ Proof (MaryEra c)
proof) [Proof (MaryEra c) -> NativeScript (MaryEra c)]
xs))
  mOf :: Int
-> [Proof (MaryEra c) -> NativeScript (MaryEra c)]
-> Proof (MaryEra c)
-> NativeScript (MaryEra c)
mOf Int
n [Proof (MaryEra c) -> NativeScript (MaryEra c)]
xs Proof (MaryEra c)
proof = forall era.
ShelleyEraScript era =>
Int -> StrictSeq (NativeScript era) -> NativeScript era
RequireMOf Int
n (forall a. [a] -> StrictSeq a
Seq.fromList (forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> a -> b
$ Proof (MaryEra c)
proof) [Proof (MaryEra c) -> NativeScript (MaryEra c)]
xs))

instance Crypto c => PostShelley (MaryEra c) where
  before :: Int -> Proof (MaryEra c) -> NativeScript (MaryEra c)
before Int
n Proof (MaryEra c)
Mary = forall era. AllegraEraScript era => SlotNo -> NativeScript era
RequireTimeStart (Int -> SlotNo
theSlot Int
n)
  after :: Int -> Proof (MaryEra c) -> NativeScript (MaryEra c)
after Int
n Proof (MaryEra c)
Mary = forall era. AllegraEraScript era => SlotNo -> NativeScript era
RequireTimeExpire (Int -> SlotNo
theSlot Int
n)

instance forall c. Crypto c => HasTokens (MaryEra c) where
  forge :: Integer -> Script (MaryEra c) -> MultiAsset (EraCrypto (MaryEra c))
forge Integer
n Script (MaryEra c)
s = forall c. Map (PolicyID c) (Map AssetName Integer) -> MultiAsset c
MultiAsset forall a b. (a -> b) -> a -> b
$ forall k a. k -> a -> Map k a
Map.singleton PolicyID c
pid (forall k a. k -> a -> Map k a
Map.singleton AssetName
an Integer
n)
    where
      pid :: PolicyID c
pid = forall c. ScriptHash c -> PolicyID c
PolicyID (forall era.
EraScript era =>
Script era -> ScriptHash (EraCrypto era)
hashScript @(MaryEra c) Script (MaryEra c)
s)
      an :: AssetName
an = ShortByteString -> AssetName
AssetName ShortByteString
"an"

instance forall c. Crypto c => HasTokens (AlonzoEra c) where
  forge :: Integer
-> Script (AlonzoEra c) -> MultiAsset (EraCrypto (AlonzoEra c))
forge Integer
n Script (AlonzoEra c)
s = forall c. Map (PolicyID c) (Map AssetName Integer) -> MultiAsset c
MultiAsset forall a b. (a -> b) -> a -> b
$ forall k a. k -> a -> Map k a
Map.singleton PolicyID c
pid (forall k a. k -> a -> Map k a
Map.singleton AssetName
an Integer
n)
    where
      pid :: PolicyID c
pid = forall c. ScriptHash c -> PolicyID c
PolicyID (forall era.
EraScript era =>
Script era -> ScriptHash (EraCrypto era)
hashScript @(AlonzoEra c) Script (AlonzoEra c)
s)
      an :: AssetName
an = ShortByteString -> AssetName
AssetName ShortByteString
"an"

instance forall c. Crypto c => HasTokens (BabbageEra c) where
  forge :: Integer
-> Script (BabbageEra c) -> MultiAsset (EraCrypto (BabbageEra c))
forge Integer
n Script (BabbageEra c)
s = forall c. Map (PolicyID c) (Map AssetName Integer) -> MultiAsset c
MultiAsset forall a b. (a -> b) -> a -> b
$ forall k a. k -> a -> Map k a
Map.singleton PolicyID c
pid (forall k a. k -> a -> Map k a
Map.singleton AssetName
an Integer
n)
    where
      pid :: PolicyID c
pid = forall c. ScriptHash c -> PolicyID c
PolicyID (forall era.
EraScript era =>
Script era -> ScriptHash (EraCrypto era)
hashScript @(BabbageEra c) Script (BabbageEra c)
s)
      an :: AssetName
an = ShortByteString -> AssetName
AssetName ShortByteString
"an"

instance forall c. Crypto c => HasTokens (ConwayEra c) where
  forge :: Integer
-> Script (ConwayEra c) -> MultiAsset (EraCrypto (ConwayEra c))
forge Integer
n Script (ConwayEra c)
s = forall c. Map (PolicyID c) (Map AssetName Integer) -> MultiAsset c
MultiAsset forall a b. (a -> b) -> a -> b
$ forall k a. k -> a -> Map k a
Map.singleton PolicyID c
pid (forall k a. k -> a -> Map k a
Map.singleton AssetName
an Integer
n)
    where
      pid :: PolicyID c
pid = forall c. ScriptHash c -> PolicyID c
PolicyID (forall era.
EraScript era =>
Script era -> ScriptHash (EraCrypto era)
hashScript @(ConwayEra c) Script (ConwayEra c)
s)
      an :: AssetName
an = ShortByteString -> AssetName
AssetName ShortByteString
"an"

-- =================================
-- Make Scripts in Alonzo era

instance Crypto c => Scriptic (AlonzoEra c) where
  never :: Natural -> Proof (AlonzoEra c) -> Script (AlonzoEra c)
never Natural
n Proof (AlonzoEra c)
Alonzo = forall (l :: Language) era.
(HasCallStack, PlutusLanguage l, AlonzoEraScript era) =>
Natural -> Script era
alwaysFails @'PlutusV1 Natural
n -- always False
  always :: Natural -> Proof (AlonzoEra c) -> Script (AlonzoEra c)
always Natural
n Proof (AlonzoEra c)
Alonzo = forall (l :: Language) era.
(HasCallStack, PlutusLanguage l, AlonzoEraScript era) =>
Natural -> Script era
alwaysSucceeds @'PlutusV1 Natural
n -- always True
  alwaysAlt :: Natural -> Proof (AlonzoEra c) -> Script (AlonzoEra c)
alwaysAlt Natural
n Proof (AlonzoEra c)
Alonzo = forall (l :: Language) era.
(HasCallStack, PlutusLanguage l, AlonzoEraScript era) =>
Natural -> Script era
alwaysSucceeds @'PlutusV1 Natural
n -- always True
  require :: KeyHash 'Witness (EraCrypto (AlonzoEra c))
-> Proof (AlonzoEra c) -> NativeScript (AlonzoEra c)
require KeyHash 'Witness (EraCrypto (AlonzoEra c))
key Proof (AlonzoEra c)
Alonzo = forall era.
ShelleyEraScript era =>
KeyHash 'Witness (EraCrypto era) -> NativeScript era
RequireSignature KeyHash 'Witness (EraCrypto (AlonzoEra c))
key
  allOf :: [Proof (AlonzoEra c) -> NativeScript (AlonzoEra c)]
-> Proof (AlonzoEra c) -> NativeScript (AlonzoEra c)
allOf [Proof (AlonzoEra c) -> NativeScript (AlonzoEra c)]
xs Proof (AlonzoEra c)
proof = forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAllOf (forall a. [a] -> StrictSeq a
Seq.fromList ((forall a b. (a -> b) -> a -> b
$ Proof (AlonzoEra c)
proof) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Proof (AlonzoEra c) -> NativeScript (AlonzoEra c)]
xs))
  anyOf :: [Proof (AlonzoEra c) -> NativeScript (AlonzoEra c)]
-> Proof (AlonzoEra c) -> NativeScript (AlonzoEra c)
anyOf [Proof (AlonzoEra c) -> NativeScript (AlonzoEra c)]
xs Proof (AlonzoEra c)
proof = forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAnyOf (forall a. [a] -> StrictSeq a
Seq.fromList ((forall a b. (a -> b) -> a -> b
$ Proof (AlonzoEra c)
proof) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Proof (AlonzoEra c) -> NativeScript (AlonzoEra c)]
xs))
  mOf :: Int
-> [Proof (AlonzoEra c) -> NativeScript (AlonzoEra c)]
-> Proof (AlonzoEra c)
-> NativeScript (AlonzoEra c)
mOf Int
n [Proof (AlonzoEra c) -> NativeScript (AlonzoEra c)]
xs Proof (AlonzoEra c)
proof = forall era.
ShelleyEraScript era =>
Int -> StrictSeq (NativeScript era) -> NativeScript era
RequireMOf Int
n (forall a. [a] -> StrictSeq a
Seq.fromList ((forall a b. (a -> b) -> a -> b
$ Proof (AlonzoEra c)
proof) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Proof (AlonzoEra c) -> NativeScript (AlonzoEra c)]
xs))

instance Crypto c => PostShelley (AlonzoEra c) where
  before :: Int -> Proof (AlonzoEra c) -> NativeScript (AlonzoEra c)
before Int
n Proof (AlonzoEra c)
Alonzo = forall era. AllegraEraScript era => SlotNo -> NativeScript era
RequireTimeStart (Int -> SlotNo
theSlot Int
n)
  after :: Int -> Proof (AlonzoEra c) -> NativeScript (AlonzoEra c)
after Int
n Proof (AlonzoEra c)
Alonzo = forall era. AllegraEraScript era => SlotNo -> NativeScript era
RequireTimeExpire (Int -> SlotNo
theSlot Int
n)

-- =================================

instance Crypto c => Scriptic (BabbageEra c) where
  never :: Natural -> Proof (BabbageEra c) -> Script (BabbageEra c)
never Natural
n Proof (BabbageEra c)
Babbage = forall (l :: Language) era.
(HasCallStack, PlutusLanguage l, AlonzoEraScript era) =>
Natural -> Script era
alwaysFails @'PlutusV1 Natural
n -- always False
  always :: Natural -> Proof (BabbageEra c) -> Script (BabbageEra c)
always Natural
n Proof (BabbageEra c)
Babbage = forall (l :: Language) era.
(HasCallStack, PlutusLanguage l, AlonzoEraScript era) =>
Natural -> Script era
alwaysSucceeds @'PlutusV1 Natural
n -- always True
  alwaysAlt :: Natural -> Proof (BabbageEra c) -> Script (BabbageEra c)
alwaysAlt Natural
n Proof (BabbageEra c)
Babbage = forall (l :: Language) era.
(HasCallStack, PlutusLanguage l, AlonzoEraScript era) =>
Natural -> Script era
alwaysSucceeds @'PlutusV2 Natural
n -- always True
  require :: KeyHash 'Witness (EraCrypto (BabbageEra c))
-> Proof (BabbageEra c) -> NativeScript (BabbageEra c)
require KeyHash 'Witness (EraCrypto (BabbageEra c))
key Proof (BabbageEra c)
Babbage = forall era.
ShelleyEraScript era =>
KeyHash 'Witness (EraCrypto era) -> NativeScript era
RequireSignature KeyHash 'Witness (EraCrypto (BabbageEra c))
key
  allOf :: [Proof (BabbageEra c) -> NativeScript (BabbageEra c)]
-> Proof (BabbageEra c) -> NativeScript (BabbageEra c)
allOf [Proof (BabbageEra c) -> NativeScript (BabbageEra c)]
xs Proof (BabbageEra c)
proof = forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAllOf (forall a. [a] -> StrictSeq a
Seq.fromList ((forall a b. (a -> b) -> a -> b
$ Proof (BabbageEra c)
proof) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Proof (BabbageEra c) -> NativeScript (BabbageEra c)]
xs))
  anyOf :: [Proof (BabbageEra c) -> NativeScript (BabbageEra c)]
-> Proof (BabbageEra c) -> NativeScript (BabbageEra c)
anyOf [Proof (BabbageEra c) -> NativeScript (BabbageEra c)]
xs Proof (BabbageEra c)
proof = forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAnyOf (forall a. [a] -> StrictSeq a
Seq.fromList ((forall a b. (a -> b) -> a -> b
$ Proof (BabbageEra c)
proof) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Proof (BabbageEra c) -> NativeScript (BabbageEra c)]
xs))
  mOf :: Int
-> [Proof (BabbageEra c) -> NativeScript (BabbageEra c)]
-> Proof (BabbageEra c)
-> NativeScript (BabbageEra c)
mOf Int
n [Proof (BabbageEra c) -> NativeScript (BabbageEra c)]
xs Proof (BabbageEra c)
proof = forall era.
ShelleyEraScript era =>
Int -> StrictSeq (NativeScript era) -> NativeScript era
RequireMOf Int
n (forall a. [a] -> StrictSeq a
Seq.fromList ((forall a b. (a -> b) -> a -> b
$ Proof (BabbageEra c)
proof) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Proof (BabbageEra c) -> NativeScript (BabbageEra c)]
xs))

instance Crypto c => PostShelley (BabbageEra c) where
  before :: Int -> Proof (BabbageEra c) -> NativeScript (BabbageEra c)
before Int
n Proof (BabbageEra c)
Babbage = forall era. AllegraEraScript era => SlotNo -> NativeScript era
RequireTimeStart (Int -> SlotNo
theSlot Int
n)
  after :: Int -> Proof (BabbageEra c) -> NativeScript (BabbageEra c)
after Int
n Proof (BabbageEra c)
Babbage = forall era. AllegraEraScript era => SlotNo -> NativeScript era
RequireTimeExpire (Int -> SlotNo
theSlot Int
n)

-- =================================

instance Crypto c => Scriptic (ConwayEra c) where
  never :: Natural -> Proof (ConwayEra c) -> Script (ConwayEra c)
never Natural
n Proof (ConwayEra c)
Conway = forall (l :: Language) era.
(HasCallStack, PlutusLanguage l, AlonzoEraScript era) =>
Natural -> Script era
alwaysFails @'PlutusV1 Natural
n -- always False
  always :: Natural -> Proof (ConwayEra c) -> Script (ConwayEra c)
always Natural
n Proof (ConwayEra c)
Conway = forall (l :: Language) era.
(HasCallStack, PlutusLanguage l, AlonzoEraScript era) =>
Natural -> Script era
alwaysSucceeds @'PlutusV1 Natural
n -- always True
  alwaysAlt :: Natural -> Proof (ConwayEra c) -> Script (ConwayEra c)
alwaysAlt Natural
n Proof (ConwayEra c)
Conway = forall (l :: Language) era.
(HasCallStack, PlutusLanguage l, AlonzoEraScript era) =>
Natural -> Script era
alwaysSucceeds @'PlutusV2 Natural
n -- always True
  require :: KeyHash 'Witness (EraCrypto (ConwayEra c))
-> Proof (ConwayEra c) -> NativeScript (ConwayEra c)
require KeyHash 'Witness (EraCrypto (ConwayEra c))
key Proof (ConwayEra c)
Conway = forall era.
ShelleyEraScript era =>
KeyHash 'Witness (EraCrypto era) -> NativeScript era
RequireSignature KeyHash 'Witness (EraCrypto (ConwayEra c))
key
  allOf :: [Proof (ConwayEra c) -> NativeScript (ConwayEra c)]
-> Proof (ConwayEra c) -> NativeScript (ConwayEra c)
allOf [Proof (ConwayEra c) -> NativeScript (ConwayEra c)]
xs Proof (ConwayEra c)
proof = forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAllOf (forall a. [a] -> StrictSeq a
Seq.fromList ((forall a b. (a -> b) -> a -> b
$ Proof (ConwayEra c)
proof) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Proof (ConwayEra c) -> NativeScript (ConwayEra c)]
xs))
  anyOf :: [Proof (ConwayEra c) -> NativeScript (ConwayEra c)]
-> Proof (ConwayEra c) -> NativeScript (ConwayEra c)
anyOf [Proof (ConwayEra c) -> NativeScript (ConwayEra c)]
xs Proof (ConwayEra c)
proof = forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAnyOf (forall a. [a] -> StrictSeq a
Seq.fromList ((forall a b. (a -> b) -> a -> b
$ Proof (ConwayEra c)
proof) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Proof (ConwayEra c) -> NativeScript (ConwayEra c)]
xs))
  mOf :: Int
-> [Proof (ConwayEra c) -> NativeScript (ConwayEra c)]
-> Proof (ConwayEra c)
-> NativeScript (ConwayEra c)
mOf Int
n [Proof (ConwayEra c) -> NativeScript (ConwayEra c)]
xs Proof (ConwayEra c)
proof = forall era.
ShelleyEraScript era =>
Int -> StrictSeq (NativeScript era) -> NativeScript era
RequireMOf Int
n (forall a. [a] -> StrictSeq a
Seq.fromList ((forall a b. (a -> b) -> a -> b
$ Proof (ConwayEra c)
proof) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Proof (ConwayEra c) -> NativeScript (ConwayEra c)]
xs))

instance Crypto c => PostShelley (ConwayEra c) where
  before :: Int -> Proof (ConwayEra c) -> NativeScript (ConwayEra c)
before Int
n Proof (ConwayEra c)
Conway = forall era. AllegraEraScript era => SlotNo -> NativeScript era
RequireTimeStart (Int -> SlotNo
theSlot Int
n)
  after :: Int -> Proof (ConwayEra c) -> NativeScript (ConwayEra c)
after Int
n Proof (ConwayEra c)
Conway = forall era. AllegraEraScript era => SlotNo -> NativeScript era
RequireTimeExpire (Int -> SlotNo
theSlot Int
n)

-- =======================================
-- Some examples that work in multiple Eras
matchkey :: Scriptic era => Int -> Proof era -> NativeScript era
matchkey :: forall era. Scriptic era => Int -> Proof era -> NativeScript era
matchkey Int
n Proof era
era = forall era.
Scriptic era =>
KeyHash 'Witness (EraCrypto era) -> Proof era -> NativeScript era
require (forall c (kr :: KeyRole). Crypto c => Int -> KeyHash kr c
theKeyHash Int
n) Proof era
era

test21 :: Scriptic era => Proof era -> Script era
test21 :: forall era. Scriptic era => Proof era -> Script era
test21 Proof era
wit = forall era. EraScript era => NativeScript era -> Script era
fromNativeScript forall a b. (a -> b) -> a -> b
$ forall era.
Scriptic era =>
[Proof era -> NativeScript era] -> Proof era -> NativeScript era
allOf [forall era. Scriptic era => Int -> Proof era -> NativeScript era
matchkey Int
1, forall era.
Scriptic era =>
[Proof era -> NativeScript era] -> Proof era -> NativeScript era
anyOf [forall era. Scriptic era => Int -> Proof era -> NativeScript era
matchkey Int
2, forall era. Scriptic era => Int -> Proof era -> NativeScript era
matchkey Int
3]] Proof era
wit

test22 :: PostShelley era => Proof era -> Script era
test22 :: forall era. PostShelley era => Proof era -> Script era
test22 Proof era
wit = forall era. EraScript era => NativeScript era -> Script era
fromNativeScript forall a b. (a -> b) -> a -> b
$ forall era.
Scriptic era =>
Int
-> [Proof era -> NativeScript era] -> Proof era -> NativeScript era
mOf Int
2 [forall era. Scriptic era => Int -> Proof era -> NativeScript era
matchkey Int
1, forall era. PostShelley era => Int -> Proof era -> NativeScript era
before Int
100, forall era.
Scriptic era =>
[Proof era -> NativeScript era] -> Proof era -> NativeScript era
anyOf [forall era. Scriptic era => Int -> Proof era -> NativeScript era
matchkey Int
2, forall era. Scriptic era => Int -> Proof era -> NativeScript era
matchkey Int
3]] Proof era
wit