{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}

module Test.Cardano.Ledger.Constrained.Scripts (
  allPlutusScripts,
  genCoreScript,
  spendPlutusScripts,
  sufficientScript,
) where

import Cardano.Ledger.Allegra.Scripts (
  AllegraEraScript,
  Timelock,
  ValidityInterval (..),
  pattern RequireTimeExpire,
  pattern RequireTimeStart,
 )
import Cardano.Ledger.Alonzo.Scripts (AlonzoScript (..))
import Cardano.Ledger.Alonzo.Tx (IsValid (..))
import Cardano.Ledger.Core (NativeScript, Script, getNativeScript, hashScript)
import Cardano.Ledger.Hashes (ScriptHash)
import Cardano.Ledger.Keys (
  KeyHash (..),
  KeyRole (..),
 )
import Cardano.Ledger.Shelley.Scripts (
  MultiSig,
  ShelleyEraScript,
  pattern RequireAllOf,
  pattern RequireAnyOf,
  pattern RequireMOf,
  pattern RequireSignature,
 )
import Cardano.Slotting.Slot (SlotNo (..))
import Control.Monad (replicateM)
import Data.Foldable (toList)
import qualified Data.List as List
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe.Strict (StrictMaybe (..))
import qualified Data.Sequence.Strict as Seq
import Data.Set (Set)
import qualified Data.Set as Set
import Numeric.Natural
import Test.Cardano.Ledger.Constrained.Combinators (genFromMap)
import Test.Cardano.Ledger.Core.KeyPair (KeyPair (..))
import Test.Cardano.Ledger.Generic.Functions (
  alwaysFalse,
  alwaysTrue,
  primaryLanguage,
 )
import Test.Cardano.Ledger.Generic.GenState
import Test.Cardano.Ledger.Generic.Proof
import Test.QuickCheck

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

type KeyMap era = Map (KeyHash 'Witness) (KeyPair 'Witness)

genMultiSig ::
  forall era.
  (ShelleyEraScript era, NativeScript era ~ MultiSig era) =>
  KeyMap era ->
  Proof era ->
  Gen (MultiSig era)
genMultiSig :: forall era.
(ShelleyEraScript era, NativeScript era ~ MultiSig era) =>
KeyMap era -> Proof era -> Gen (MultiSig era)
genMultiSig KeyMap era
keymap Proof era
_proof = do
  let genNestedMultiSig :: Natural -> Gen (MultiSig era)
      genNestedMultiSig :: Natural -> Gen (MultiSig era)
genNestedMultiSig Natural
k
        | Natural
k Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
> Natural
0 =
            [Gen (MultiSig era)] -> Gen (MultiSig era)
forall a. HasCallStack => [Gen a] -> Gen a
oneof ([Gen (MultiSig era)] -> Gen (MultiSig era))
-> [Gen (MultiSig era)] -> Gen (MultiSig era)
forall a b. (a -> b) -> a -> b
$
              [Gen (MultiSig era)]
nonRecTimelocks [Gen (MultiSig era)]
-> [Gen (MultiSig era)] -> [Gen (MultiSig era)]
forall a. [a] -> [a] -> [a]
++ [Natural -> Gen (MultiSig era)
requireAllOf Natural
k, Natural -> Gen (MultiSig era)
requireAnyOf Natural
k, Natural -> Gen (MultiSig era)
requireMOf Natural
k]
        | Bool
otherwise = [Gen (MultiSig era)] -> Gen (MultiSig era)
forall a. HasCallStack => [Gen a] -> Gen a
oneof [Gen (MultiSig era)]
nonRecTimelocks
      nonRecTimelocks :: [Gen (MultiSig era)]
nonRecTimelocks = [Gen (MultiSig era)
requireSignature]
      requireSignature :: Gen (MultiSig era)
requireSignature =
        forall era.
ShelleyEraScript era =>
KeyHash 'Witness -> NativeScript era
RequireSignature @era (KeyHash 'Witness -> MultiSig era)
-> ((KeyHash 'Witness, KeyPair 'Witness) -> KeyHash 'Witness)
-> (KeyHash 'Witness, KeyPair 'Witness)
-> MultiSig era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeyHash 'Witness, KeyPair 'Witness) -> KeyHash 'Witness
forall a b. (a, b) -> a
fst ((KeyHash 'Witness, KeyPair 'Witness) -> MultiSig era)
-> Gen (KeyHash 'Witness, KeyPair 'Witness) -> Gen (MultiSig era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> KeyMap era -> Gen (KeyHash 'Witness, KeyPair 'Witness)
forall k a. [String] -> Map k a -> Gen (k, a)
genFromMap [String
"from requiresSignature in genMultiSig"] KeyMap era
keymap
      requireAllOf :: Natural -> Gen (MultiSig era)
requireAllOf Natural
k = do
        Int
n <- Gen Int
nonNegativeSingleDigitInt
        StrictSeq (NativeScript era) -> NativeScript era
StrictSeq (MultiSig era) -> MultiSig era
forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAllOf (StrictSeq (MultiSig era) -> MultiSig era)
-> ([MultiSig era] -> StrictSeq (MultiSig era))
-> [MultiSig era]
-> MultiSig era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MultiSig era] -> StrictSeq (MultiSig era)
forall a. [a] -> StrictSeq a
Seq.fromList ([MultiSig era] -> MultiSig era)
-> Gen [MultiSig era] -> Gen (MultiSig era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen (MultiSig era) -> Gen [MultiSig era]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n (Natural -> Gen (MultiSig era)
genNestedMultiSig (Natural
k Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
1))
      requireAnyOf :: Natural -> Gen (MultiSig era)
requireAnyOf Natural
k = do
        Int
n <- Gen Int
positiveSingleDigitInt
        StrictSeq (NativeScript era) -> NativeScript era
StrictSeq (MultiSig era) -> MultiSig era
forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAnyOf (StrictSeq (MultiSig era) -> MultiSig era)
-> ([MultiSig era] -> StrictSeq (MultiSig era))
-> [MultiSig era]
-> MultiSig era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MultiSig era] -> StrictSeq (MultiSig era)
forall a. [a] -> StrictSeq a
Seq.fromList ([MultiSig era] -> MultiSig era)
-> Gen [MultiSig era] -> Gen (MultiSig era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen (MultiSig era) -> Gen [MultiSig era]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n (Natural -> Gen (MultiSig era)
genNestedMultiSig (Natural
k Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
1))
      requireMOf :: Natural -> Gen (MultiSig era)
requireMOf Natural
k = do
        Int
n <- Gen Int
nonNegativeSingleDigitInt
        Int
m <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0, Int
n)
        Int -> StrictSeq (NativeScript era) -> NativeScript era
forall era.
ShelleyEraScript era =>
Int -> StrictSeq (NativeScript era) -> NativeScript era
RequireMOf Int
m (StrictSeq (MultiSig era) -> MultiSig era)
-> ([MultiSig era] -> StrictSeq (MultiSig era))
-> [MultiSig era]
-> MultiSig era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MultiSig era] -> StrictSeq (MultiSig era)
forall a. [a] -> StrictSeq a
Seq.fromList ([MultiSig era] -> MultiSig era)
-> Gen [MultiSig era] -> Gen (MultiSig era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen (MultiSig era) -> Gen [MultiSig era]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n (Natural -> Gen (MultiSig era)
genNestedMultiSig (Natural
k Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
1))
  Natural -> Gen (MultiSig era)
genNestedMultiSig (Natural
2 :: Natural)

genTimelock ::
  forall era.
  (AllegraEraScript era, NativeScript era ~ Timelock era) =>
  KeyMap era ->
  ValidityInterval ->
  Proof era ->
  Gen (Timelock era)
genTimelock :: forall era.
(AllegraEraScript era, NativeScript era ~ Timelock era) =>
KeyMap era -> ValidityInterval -> Proof era -> Gen (Timelock era)
genTimelock KeyMap era
keymap (ValidityInterval StrictMaybe SlotNo
mBefore StrictMaybe SlotNo
mAfter) Proof era
_proof = do
  -- We need to limit how deep these timelocks can go, otherwise this generator will
  -- diverge. It also has to stay very shallow because it grows too fast.
  let genNestedTimelock :: Natural -> Gen (Timelock era)
genNestedTimelock Natural
k
        | Natural
k Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
> Natural
0 =
            [Gen (Timelock era)] -> Gen (Timelock era)
forall a. HasCallStack => [Gen a] -> Gen a
oneof ([Gen (Timelock era)] -> Gen (Timelock era))
-> [Gen (Timelock era)] -> Gen (Timelock era)
forall a b. (a -> b) -> a -> b
$
              [Gen (Timelock era)]
nonRecTimelocks [Gen (Timelock era)]
-> [Gen (Timelock era)] -> [Gen (Timelock era)]
forall a. [a] -> [a] -> [a]
++ [Natural -> Gen (Timelock era)
requireAllOf Natural
k, Natural -> Gen (Timelock era)
requireAnyOf Natural
k, Natural -> Gen (Timelock era)
requireMOf Natural
k]
        | Bool
otherwise = [Gen (Timelock era)] -> Gen (Timelock era)
forall a. HasCallStack => [Gen a] -> Gen a
oneof [Gen (Timelock era)]
nonRecTimelocks
      nonRecTimelocks :: [Gen (Timelock era)]
      nonRecTimelocks :: [Gen (Timelock era)]
nonRecTimelocks =
        [ Gen (Timelock era)
r
        | SJust Gen (Timelock era)
r <-
            [ SlotNo -> Gen (Timelock era)
SlotNo -> Gen (NativeScript era)
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 AllegraEraScript era) =>
SlotNo -> Gen (NativeScript era)
requireTimeStart (SlotNo -> Gen (Timelock era))
-> StrictMaybe SlotNo -> StrictMaybe (Gen (Timelock era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictMaybe SlotNo
mBefore
            , SlotNo -> Gen (Timelock era)
SlotNo -> Gen (NativeScript era)
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 AllegraEraScript era) =>
SlotNo -> Gen (NativeScript era)
requireTimeExpire (SlotNo -> Gen (Timelock era))
-> StrictMaybe SlotNo -> StrictMaybe (Gen (Timelock era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictMaybe SlotNo
mAfter
            , Gen (Timelock era) -> StrictMaybe (Gen (Timelock era))
forall a. a -> StrictMaybe a
SJust Gen (Timelock era)
requireSignature
            ]
        ]
      requireSignature :: Gen (Timelock era)
requireSignature = KeyHash 'Witness -> Timelock era
KeyHash 'Witness -> NativeScript era
forall era.
ShelleyEraScript era =>
KeyHash 'Witness -> NativeScript era
RequireSignature (KeyHash 'Witness -> Timelock era)
-> ((KeyHash 'Witness, KeyPair 'Witness) -> KeyHash 'Witness)
-> (KeyHash 'Witness, KeyPair 'Witness)
-> Timelock era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeyHash 'Witness, KeyPair 'Witness) -> KeyHash 'Witness
forall a b. (a, b) -> a
fst ((KeyHash 'Witness, KeyPair 'Witness) -> Timelock era)
-> Gen (KeyHash 'Witness, KeyPair 'Witness) -> Gen (Timelock era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> KeyMap era -> Gen (KeyHash 'Witness, KeyPair 'Witness)
forall k a. [String] -> Map k a -> Gen (k, a)
genFromMap [String
"from requiresSignature in genTimelock"] KeyMap era
keymap
      requireAllOf :: Natural -> Gen (Timelock era)
requireAllOf Natural
k = do
        Int
n <- Gen Int
nonNegativeSingleDigitInt
        StrictSeq (Timelock era) -> Timelock era
StrictSeq (NativeScript era) -> NativeScript era
forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAllOf (StrictSeq (Timelock era) -> Timelock era)
-> ([Timelock era] -> StrictSeq (Timelock era))
-> [Timelock era]
-> Timelock era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Timelock era] -> StrictSeq (Timelock era)
forall a. [a] -> StrictSeq a
Seq.fromList ([Timelock era] -> Timelock era)
-> Gen [Timelock era] -> Gen (Timelock era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen (Timelock era) -> Gen [Timelock era]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n (Natural -> Gen (Timelock era)
genNestedTimelock (Natural
k Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
1))
      requireAnyOf :: Natural -> Gen (Timelock era)
requireAnyOf Natural
k = do
        Int
n <- Gen Int
positiveSingleDigitInt
        StrictSeq (Timelock era) -> Timelock era
StrictSeq (NativeScript era) -> NativeScript era
forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAnyOf (StrictSeq (Timelock era) -> Timelock era)
-> ([Timelock era] -> StrictSeq (Timelock era))
-> [Timelock era]
-> Timelock era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Timelock era] -> StrictSeq (Timelock era)
forall a. [a] -> StrictSeq a
Seq.fromList ([Timelock era] -> Timelock era)
-> Gen [Timelock era] -> Gen (Timelock era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen (Timelock era) -> Gen [Timelock era]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n (Natural -> Gen (Timelock era)
genNestedTimelock (Natural
k Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
1))
      requireMOf :: Natural -> Gen (Timelock era)
requireMOf Natural
k = do
        Int
n <- Gen Int
nonNegativeSingleDigitInt
        Int
m <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0, Int
n)
        Int -> StrictSeq (NativeScript era) -> NativeScript era
forall era.
ShelleyEraScript era =>
Int -> StrictSeq (NativeScript era) -> NativeScript era
RequireMOf Int
m (StrictSeq (Timelock era) -> Timelock era)
-> ([Timelock era] -> StrictSeq (Timelock era))
-> [Timelock era]
-> Timelock era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Timelock era] -> StrictSeq (Timelock era)
forall a. [a] -> StrictSeq a
Seq.fromList ([Timelock era] -> Timelock era)
-> Gen [Timelock era] -> Gen (Timelock era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen (Timelock era) -> Gen [Timelock era]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n (Natural -> Gen (Timelock era)
genNestedTimelock (Natural
k Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
1))
      requireTimeStart :: SlotNo -> Gen (NativeScript era)
requireTimeStart (SlotNo Word64
validFrom) = do
        Word64
minSlotNo <- (Word64, Word64) -> Gen Word64
forall a. Random a => (a, a) -> Gen a
choose (Word64
forall a. Bounded a => a
minBound, Word64
validFrom)
        NativeScript era -> Gen (NativeScript era)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NativeScript era -> Gen (NativeScript era))
-> NativeScript era -> Gen (NativeScript era)
forall a b. (a -> b) -> a -> b
$ SlotNo -> NativeScript era
forall era. AllegraEraScript era => SlotNo -> NativeScript era
RequireTimeStart (Word64 -> SlotNo
SlotNo Word64
minSlotNo)
      requireTimeExpire :: SlotNo -> Gen (NativeScript era)
requireTimeExpire (SlotNo Word64
validTill) = do
        Word64
maxSlotNo <- (Word64, Word64) -> Gen Word64
forall a. Random a => (a, a) -> Gen a
choose (Word64
validTill, Word64
forall a. Bounded a => a
maxBound)
        NativeScript era -> Gen (NativeScript era)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NativeScript era -> Gen (NativeScript era))
-> NativeScript era -> Gen (NativeScript era)
forall a b. (a -> b) -> a -> b
$ SlotNo -> NativeScript era
forall era. AllegraEraScript era => SlotNo -> NativeScript era
RequireTimeExpire (Word64 -> SlotNo
SlotNo Word64
maxSlotNo)
  Natural -> Gen (Timelock era)
genNestedTimelock (Natural
2 :: Natural)

genPlutusScript ::
  forall era.
  PlutusPurposeTag ->
  Proof era ->
  Gen (Bool, Script era)
genPlutusScript :: forall era. PlutusPurposeTag -> Proof era -> Gen (Bool, Script era)
genPlutusScript PlutusPurposeTag
tag Proof era
proof = do
  Bool
isValid <- [(Int, Gen Bool)] -> Gen Bool
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency [(Int
5, Bool -> Gen Bool
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False), (Int
95, Bool -> Gen Bool
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True)]
  -- Plutus scripts alwaysSucceeds needs at least numArgs, while
  -- alwaysFails needs exactly numArgs to have the desired affect.
  -- For reasons unknown, this number differs from Alonzo to Babbage
  -- Perhaps because Babbage is using PlutusV2 scripts?
  let numArgs :: Natural
numArgs = case (Proof era
proof, PlutusPurposeTag
tag) of
        (Proof era
Conway, PlutusPurposeTag
Spending) -> Natural
2
        (Proof era
Conway, PlutusPurposeTag
_) -> Natural
1
        (Proof era
Babbage, PlutusPurposeTag
Spending) -> Natural
2
        (Proof era
Babbage, PlutusPurposeTag
_) -> Natural
1
        (Proof era
_, PlutusPurposeTag
Spending) -> Natural
3
        (Proof era
_, PlutusPurposeTag
_) -> Natural
2
  -- While using varying number of arguments for alwaysSucceeds we get
  -- varying script hashes, which helps with the fuzziness
  let mlanguage :: Maybe Language
mlanguage = Proof era -> Maybe Language
forall era. Proof era -> Maybe Language
primaryLanguage Proof era
proof
  if Bool
isValid
    then (,) Bool
isValid (Script era -> (Bool, Script era))
-> (Natural -> Script era) -> Natural -> (Bool, Script era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proof era -> Maybe Language -> Natural -> Script era
forall era. Proof era -> Maybe Language -> Natural -> Script era
alwaysTrue Proof era
proof Maybe Language
mlanguage (Natural -> Script era)
-> (Natural -> Natural) -> Natural -> Script era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
numArgs) (Natural -> (Bool, Script era))
-> Gen Natural -> Gen (Bool, Script era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Natural] -> Gen Natural
forall a. HasCallStack => [a] -> Gen a
elements [Natural
0, Natural
1, Natural
2, Natural
3 :: Natural])
    else (Bool, Script era) -> Gen (Bool, Script era)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Bool, Script era) -> Gen (Bool, Script era))
-> (Bool, Script era) -> Gen (Bool, Script era)
forall a b. (a -> b) -> a -> b
$ (Bool
isValid, Proof era -> Maybe Language -> Natural -> Script era
forall era. Proof era -> Maybe Language -> Natural -> Script era
alwaysFalse Proof era
proof Maybe Language
mlanguage Natural
numArgs)

genCoreScript ::
  forall era.
  Proof era ->
  PlutusPurposeTag ->
  KeyMap era ->
  ValidityInterval ->
  Gen (Script era)
genCoreScript :: forall era.
Proof era
-> PlutusPurposeTag
-> KeyMap era
-> ValidityInterval
-> Gen (Script era)
genCoreScript Proof era
proof PlutusPurposeTag
tag KeyMap era
keymap ValidityInterval
vi = case Proof era
proof of
  Proof era
Conway ->
    [(Int, Gen (AlonzoScript era))] -> Gen (AlonzoScript era)
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
      [ (Int
1, Timelock era -> AlonzoScript era
forall era. Timelock era -> AlonzoScript era
TimelockScript (Timelock era -> AlonzoScript era)
-> Gen (Timelock era) -> Gen (AlonzoScript era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyMap era -> ValidityInterval -> Proof era -> Gen (Timelock era)
forall era.
(AllegraEraScript era, NativeScript era ~ Timelock era) =>
KeyMap era -> ValidityInterval -> Proof era -> Gen (Timelock era)
genTimelock KeyMap era
keymap ValidityInterval
vi Proof era
proof)
      -- TODO Add this once scripts are working in Conway
      -- , (1, snd <$> genPlutusScript tag proof)
      ]
  Proof era
Babbage ->
    [(Int, Gen (AlonzoScript era))] -> Gen (AlonzoScript era)
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
      [ (Int
1, Timelock era -> AlonzoScript era
forall era. Timelock era -> AlonzoScript era
TimelockScript (Timelock era -> AlonzoScript era)
-> Gen (Timelock era) -> Gen (AlonzoScript era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyMap era -> ValidityInterval -> Proof era -> Gen (Timelock era)
forall era.
(AllegraEraScript era, NativeScript era ~ Timelock era) =>
KeyMap era -> ValidityInterval -> Proof era -> Gen (Timelock era)
genTimelock KeyMap era
keymap ValidityInterval
vi Proof era
proof)
      , (Int
1, (Bool, AlonzoScript era) -> AlonzoScript era
forall a b. (a, b) -> b
snd ((Bool, AlonzoScript era) -> AlonzoScript era)
-> Gen (Bool, AlonzoScript era) -> Gen (AlonzoScript era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PlutusPurposeTag -> Proof era -> Gen (Bool, Script era)
forall era. PlutusPurposeTag -> Proof era -> Gen (Bool, Script era)
genPlutusScript PlutusPurposeTag
tag Proof era
proof)
      ]
  Proof era
Alonzo ->
    [(Int, Gen (AlonzoScript era))] -> Gen (AlonzoScript era)
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
      [ (Int
1, Timelock era -> AlonzoScript era
forall era. Timelock era -> AlonzoScript era
TimelockScript (Timelock era -> AlonzoScript era)
-> Gen (Timelock era) -> Gen (AlonzoScript era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyMap era -> ValidityInterval -> Proof era -> Gen (Timelock era)
forall era.
(AllegraEraScript era, NativeScript era ~ Timelock era) =>
KeyMap era -> ValidityInterval -> Proof era -> Gen (Timelock era)
genTimelock KeyMap era
keymap ValidityInterval
vi Proof era
proof)
      , (Int
1, (Bool, AlonzoScript era) -> AlonzoScript era
forall a b. (a, b) -> b
snd ((Bool, AlonzoScript era) -> AlonzoScript era)
-> Gen (Bool, AlonzoScript era) -> Gen (AlonzoScript era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PlutusPurposeTag -> Proof era -> Gen (Bool, Script era)
forall era. PlutusPurposeTag -> Proof era -> Gen (Bool, Script era)
genPlutusScript PlutusPurposeTag
tag Proof era
proof)
      ]
  Proof era
Mary -> KeyMap era -> ValidityInterval -> Proof era -> Gen (Timelock era)
forall era.
(AllegraEraScript era, NativeScript era ~ Timelock era) =>
KeyMap era -> ValidityInterval -> Proof era -> Gen (Timelock era)
genTimelock KeyMap era
keymap ValidityInterval
vi Proof era
proof
  Proof era
Allegra -> KeyMap era -> ValidityInterval -> Proof era -> Gen (Timelock era)
forall era.
(AllegraEraScript era, NativeScript era ~ Timelock era) =>
KeyMap era -> ValidityInterval -> Proof era -> Gen (Timelock era)
genTimelock KeyMap era
keymap ValidityInterval
vi Proof era
proof
  Proof era
Shelley -> KeyMap era -> Proof era -> Gen (MultiSig era)
forall era.
(ShelleyEraScript era, NativeScript era ~ MultiSig era) =>
KeyMap era -> Proof era -> Gen (MultiSig era)
genMultiSig KeyMap era
keymap Proof era
proof

-- | For any given Era, there are only a finite number of Plutus scripts.
--   This function computes all of them. There will be two failing scripts
--   One for the Spend Tag, and another for all other Tags (Mint, Cert, Rewrd).
--   The non-failing Spend scripts have varying number of arguments (0, 1, 2, 3)
--   The non-failing (Mint Cert Rewrd) scripts are identical.
--   Any Plutus script generated by 'genCoreScript' will be in this Map.
allPlutusScripts ::
  Reflect era => Proof era -> Map ScriptHash (IsValid, Script era)
allPlutusScripts :: forall era.
Reflect era =>
Proof era -> Map ScriptHash (IsValid, Script era)
allPlutusScripts Proof era
proof =
  [(ScriptHash, (IsValid, Script era))]
-> Map ScriptHash (IsValid, Script era)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(ScriptHash, (IsValid, Script era))]
 -> Map ScriptHash (IsValid, Script era))
-> [(ScriptHash, (IsValid, Script era))]
-> Map ScriptHash (IsValid, Script era)
forall a b. (a -> b) -> a -> b
$
    ((IsValid, Script era) -> (ScriptHash, (IsValid, Script era)))
-> [(IsValid, Script era)] -> [(ScriptHash, (IsValid, Script era))]
forall a b. (a -> b) -> [a] -> [b]
map (IsValid, Script era) -> (ScriptHash, (IsValid, Script era))
forall {era} {a}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 EraScript era) =>
(a, Script era) -> (ScriptHash, (a, Script era))
hash ((PlutusPurposeTag -> [(IsValid, Script era)])
-> [PlutusPurposeTag] -> [(IsValid, Script era)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Proof era -> PlutusPurposeTag -> [(IsValid, Script era)]
forall era.
Proof era -> PlutusPurposeTag -> [(IsValid, Script era)]
plutusByTag Proof era
proof) (Proof era -> [PlutusPurposeTag]
forall era. Proof era -> [PlutusPurposeTag]
plutusPurposeTags Proof era
proof))
  where
    hash :: (a, Script era) -> (ScriptHash, (a, Script era))
hash (a
b, Script era
s) = (Script era -> ScriptHash
forall era. EraScript era => Script era -> ScriptHash
hashScript Script era
s, (a
b, Script era
s))

-- | There are only 5 plutus scripts that can be used in a Spend context
spendPlutusScripts ::
  Reflect era => Proof era -> Map ScriptHash (IsValid, Script era)
spendPlutusScripts :: forall era.
Reflect era =>
Proof era -> Map ScriptHash (IsValid, Script era)
spendPlutusScripts Proof era
proof = [(ScriptHash, (IsValid, Script era))]
-> Map ScriptHash (IsValid, Script era)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (((IsValid, Script era) -> (ScriptHash, (IsValid, Script era)))
-> [(IsValid, Script era)] -> [(ScriptHash, (IsValid, Script era))]
forall a b. (a -> b) -> [a] -> [b]
map (IsValid, Script era) -> (ScriptHash, (IsValid, Script era))
forall {era} {a}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 EraScript era) =>
(a, Script era) -> (ScriptHash, (a, Script era))
hash (Proof era -> PlutusPurposeTag -> [(IsValid, Script era)]
forall era.
Proof era -> PlutusPurposeTag -> [(IsValid, Script era)]
plutusByTag Proof era
proof PlutusPurposeTag
Spending))
  where
    hash :: (a, Script era) -> (ScriptHash, (a, Script era))
hash (a
b, Script era
s) = (Script era -> ScriptHash
forall era. EraScript era => Script era -> ScriptHash
hashScript Script era
s, (a
b, Script era
s))

plutusByTag :: Proof era -> PlutusPurposeTag -> [(IsValid, Script era)]
plutusByTag :: forall era.
Proof era -> PlutusPurposeTag -> [(IsValid, Script era)]
plutusByTag Proof era
proof PlutusPurposeTag
tag = [(IsValid, Script era)]
trueS [(IsValid, Script era)]
-> [(IsValid, Script era)] -> [(IsValid, Script era)]
forall a. [a] -> [a] -> [a]
++ [(IsValid, Script era)]
falseS
  where
    numArgs :: Natural
numArgs = case (Proof era
proof, PlutusPurposeTag
tag) of
      (Proof era
Conway, PlutusPurposeTag
Spending) -> Natural
2
      (Proof era
Conway, PlutusPurposeTag
_) -> Natural
1
      (Proof era
Babbage, PlutusPurposeTag
Spending) -> Natural
2
      (Proof era
Babbage, PlutusPurposeTag
_) -> Natural
1
      (Proof era
_, PlutusPurposeTag
Spending) -> Natural
3
      (Proof era
_, PlutusPurposeTag
_) -> Natural
2
    trueS :: [(IsValid, Script era)]
trueS = [(Bool -> IsValid
IsValid Bool
True, Proof era -> Maybe Language -> Natural -> Script era
forall era. Proof era -> Maybe Language -> Natural -> Script era
alwaysTrue Proof era
proof Maybe Language
mlanguage (Natural
numArgs Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
n)) | Natural
n <- [Natural
0, Natural
1, Natural
2, Natural
3 :: Natural]]
    falseS :: [(IsValid, Script era)]
falseS = [(Bool -> IsValid
IsValid Bool
False, Proof era -> Maybe Language -> Natural -> Script era
forall era. Proof era -> Maybe Language -> Natural -> Script era
alwaysFalse Proof era
proof Maybe Language
mlanguage Natural
numArgs)]
    mlanguage :: Maybe Language
mlanguage = Proof era -> Maybe Language
forall era. Proof era -> Maybe Language
primaryLanguage Proof era
proof

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

-- The function 'witsVKeyNeededFromBody' computes the necesary (but not sufficient)
-- key witnesses. Some of the missing ones have to do with MultiSig (and Timelock) scripts
-- So we need to compute the smallest set possible for Scripts. A MultiSig (Timelock) scripts
-- needs enough key witnesses, so that some subset of the Signature scripts to make it True.

sufficientMultiSig ::
  (ShelleyEraScript era, NativeScript era ~ MultiSig era) =>
  MultiSig era ->
  Set (KeyHash 'Witness)
sufficientMultiSig :: forall era.
(ShelleyEraScript era, NativeScript era ~ MultiSig era) =>
MultiSig era -> Set (KeyHash 'Witness)
sufficientMultiSig MultiSig era
x = case MultiSig era
x of
  RequireSignature KeyHash 'Witness
kh -> KeyHash 'Witness -> Set (KeyHash 'Witness)
forall a. a -> Set a
Set.singleton KeyHash 'Witness
kh
  RequireAllOf StrictSeq (NativeScript era)
xs -> StrictSeq (Set (KeyHash 'Witness)) -> Set (KeyHash 'Witness)
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions (MultiSig era -> Set (KeyHash 'Witness)
forall era.
(ShelleyEraScript era, NativeScript era ~ MultiSig era) =>
MultiSig era -> Set (KeyHash 'Witness)
sufficientMultiSig (MultiSig era -> Set (KeyHash 'Witness))
-> StrictSeq (MultiSig era) -> StrictSeq (Set (KeyHash 'Witness))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictSeq (NativeScript era)
StrictSeq (MultiSig era)
xs)
  RequireAnyOf StrictSeq (NativeScript era)
xs ->
    case (Set (KeyHash 'Witness) -> Set (KeyHash 'Witness) -> Ordering)
-> [Set (KeyHash 'Witness)] -> [Set (KeyHash 'Witness)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
List.sortBy Set (KeyHash 'Witness) -> Set (KeyHash 'Witness) -> Ordering
forall {a} {a}. Set a -> Set a -> Ordering
p ((Set (KeyHash 'Witness) -> Bool)
-> [Set (KeyHash 'Witness)] -> [Set (KeyHash 'Witness)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (Set (KeyHash 'Witness) -> Bool)
-> Set (KeyHash 'Witness)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (KeyHash 'Witness) -> Bool
forall a. Set a -> Bool
Set.null) (MultiSig era -> Set (KeyHash 'Witness)
forall era.
(ShelleyEraScript era, NativeScript era ~ MultiSig era) =>
MultiSig era -> Set (KeyHash 'Witness)
sufficientMultiSig (MultiSig era -> Set (KeyHash 'Witness))
-> [MultiSig era] -> [Set (KeyHash 'Witness)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StrictSeq (MultiSig era) -> [MultiSig era]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (NativeScript era)
StrictSeq (MultiSig era)
xs))) of
      [] -> Set (KeyHash 'Witness)
forall a. Set a
Set.empty
      (Set (KeyHash 'Witness)
s : [Set (KeyHash 'Witness)]
_) -> Set (KeyHash 'Witness)
s
  RequireMOf Int
n StrictSeq (NativeScript era)
xs -> [Set (KeyHash 'Witness)] -> Set (KeyHash 'Witness)
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions (Int -> [Set (KeyHash 'Witness)] -> [Set (KeyHash 'Witness)]
forall a. Int -> [a] -> [a]
take Int
n ((Set (KeyHash 'Witness) -> Set (KeyHash 'Witness) -> Ordering)
-> [Set (KeyHash 'Witness)] -> [Set (KeyHash 'Witness)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
List.sortBy Set (KeyHash 'Witness) -> Set (KeyHash 'Witness) -> Ordering
forall {a} {a}. Set a -> Set a -> Ordering
p (MultiSig era -> Set (KeyHash 'Witness)
forall era.
(ShelleyEraScript era, NativeScript era ~ MultiSig era) =>
MultiSig era -> Set (KeyHash 'Witness)
sufficientMultiSig (MultiSig era -> Set (KeyHash 'Witness))
-> [MultiSig era] -> [Set (KeyHash 'Witness)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StrictSeq (MultiSig era) -> [MultiSig era]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (NativeScript era)
StrictSeq (MultiSig era)
xs))))
  MultiSig era
_ -> String -> Set (KeyHash 'Witness)
forall a. HasCallStack => String -> a
error String
"Impossible: All NativeScripts should have been accounted for"
  where
    p :: Set a -> Set a -> Ordering
p Set a
a Set a
b = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Set a -> Int
forall a. Set a -> Int
Set.size Set a
a) (Set a -> Int
forall a. Set a -> Int
Set.size Set a
b)

-- | Return sufficient KeyHash to make the Timelock succeed. Note that some Timelock
--   scripts need no KeyHashes to succeed (RequireTimeExpire, RequireTimeStart)
sufficientTimelock ::
  (AllegraEraScript era, NativeScript era ~ Timelock era) =>
  Timelock era ->
  Set (KeyHash 'Witness)
sufficientTimelock :: forall era.
(AllegraEraScript era, NativeScript era ~ Timelock era) =>
Timelock era -> Set (KeyHash 'Witness)
sufficientTimelock Timelock era
x = case Timelock era
x of
  RequireSignature KeyHash 'Witness
kh -> KeyHash 'Witness -> Set (KeyHash 'Witness)
forall a. a -> Set a
Set.singleton KeyHash 'Witness
kh
  RequireAllOf StrictSeq (NativeScript era)
xs -> StrictSeq (Set (KeyHash 'Witness)) -> Set (KeyHash 'Witness)
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ((Timelock era -> Set (KeyHash 'Witness))
-> StrictSeq (Timelock era) -> StrictSeq (Set (KeyHash 'Witness))
forall a b. (a -> b) -> StrictSeq a -> StrictSeq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Timelock era -> Set (KeyHash 'Witness)
forall era.
(AllegraEraScript era, NativeScript era ~ Timelock era) =>
Timelock era -> Set (KeyHash 'Witness)
sufficientTimelock StrictSeq (Timelock era)
StrictSeq (NativeScript era)
xs)
  RequireAnyOf StrictSeq (NativeScript era)
xs ->
    case (Set (KeyHash 'Witness) -> Set (KeyHash 'Witness) -> Ordering)
-> [Set (KeyHash 'Witness)] -> [Set (KeyHash 'Witness)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
List.sortBy Set (KeyHash 'Witness) -> Set (KeyHash 'Witness) -> Ordering
forall {a} {a}. Set a -> Set a -> Ordering
p ((Set (KeyHash 'Witness) -> Bool)
-> [Set (KeyHash 'Witness)] -> [Set (KeyHash 'Witness)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (Set (KeyHash 'Witness) -> Bool)
-> Set (KeyHash 'Witness)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (KeyHash 'Witness) -> Bool
forall a. Set a -> Bool
Set.null) ((Timelock era -> Set (KeyHash 'Witness))
-> [Timelock era] -> [Set (KeyHash 'Witness)]
forall a b. (a -> b) -> [a] -> [b]
map Timelock era -> Set (KeyHash 'Witness)
forall era.
(AllegraEraScript era, NativeScript era ~ Timelock era) =>
Timelock era -> Set (KeyHash 'Witness)
sufficientTimelock (StrictSeq (Timelock era) -> [Timelock era]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (Timelock era)
StrictSeq (NativeScript era)
xs))) of
      [] -> Set (KeyHash 'Witness)
forall a. Set a
Set.empty
      (Set (KeyHash 'Witness)
s : [Set (KeyHash 'Witness)]
_) -> Set (KeyHash 'Witness)
s
  RequireMOf Int
n StrictSeq (NativeScript era)
xs -> [Set (KeyHash 'Witness)] -> Set (KeyHash 'Witness)
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions (Int -> [Set (KeyHash 'Witness)] -> [Set (KeyHash 'Witness)]
forall a. Int -> [a] -> [a]
take Int
n ((Set (KeyHash 'Witness) -> Set (KeyHash 'Witness) -> Ordering)
-> [Set (KeyHash 'Witness)] -> [Set (KeyHash 'Witness)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
List.sortBy Set (KeyHash 'Witness) -> Set (KeyHash 'Witness) -> Ordering
forall {a} {a}. Set a -> Set a -> Ordering
p ((Timelock era -> Set (KeyHash 'Witness))
-> [Timelock era] -> [Set (KeyHash 'Witness)]
forall a b. (a -> b) -> [a] -> [b]
map Timelock era -> Set (KeyHash 'Witness)
forall era.
(AllegraEraScript era, NativeScript era ~ Timelock era) =>
Timelock era -> Set (KeyHash 'Witness)
sufficientTimelock (StrictSeq (Timelock era) -> [Timelock era]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (Timelock era)
StrictSeq (NativeScript era)
xs))))
  RequireTimeExpire {} -> Set (KeyHash 'Witness)
forall a. Set a
Set.empty
  RequireTimeStart {} -> Set (KeyHash 'Witness)
forall a. Set a
Set.empty
  where
    p :: Set a -> Set a -> Ordering
p Set a
a Set a
b = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Set a -> Int
forall a. Set a -> Int
Set.size Set a
a) (Set a -> Int
forall a. Set a -> Int
Set.size Set a
b)

sufficientScript :: Proof era -> Script era -> Set (KeyHash 'Witness)
sufficientScript :: forall era. Proof era -> Script era -> Set (KeyHash 'Witness)
sufficientScript Proof era
p Script era
s = case Proof era
p of
  Proof era
Shelley -> MultiSig ShelleyEra -> Set (KeyHash 'Witness)
forall era.
(ShelleyEraScript era, NativeScript era ~ MultiSig era) =>
MultiSig era -> Set (KeyHash 'Witness)
sufficientMultiSig Script era
MultiSig ShelleyEra
s
  Proof era
Allegra -> Timelock AllegraEra -> Set (KeyHash 'Witness)
forall era.
(AllegraEraScript era, NativeScript era ~ Timelock era) =>
Timelock era -> Set (KeyHash 'Witness)
sufficientTimelock Timelock AllegraEra
Script era
s
  Proof era
Mary -> Timelock MaryEra -> Set (KeyHash 'Witness)
forall era.
(AllegraEraScript era, NativeScript era ~ Timelock era) =>
Timelock era -> Set (KeyHash 'Witness)
sufficientTimelock Timelock MaryEra
Script era
s
  Proof era
Alonzo -> Set (KeyHash 'Witness)
-> (Timelock AlonzoEra -> Set (KeyHash 'Witness))
-> Maybe (Timelock AlonzoEra)
-> Set (KeyHash 'Witness)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set (KeyHash 'Witness)
forall a. Set a
Set.empty Timelock AlonzoEra -> Set (KeyHash 'Witness)
forall era.
(AllegraEraScript era, NativeScript era ~ Timelock era) =>
Timelock era -> Set (KeyHash 'Witness)
sufficientTimelock (Script AlonzoEra -> Maybe (NativeScript AlonzoEra)
forall era. EraScript era => Script era -> Maybe (NativeScript era)
getNativeScript Script era
Script AlonzoEra
s)
  Proof era
Babbage -> Set (KeyHash 'Witness)
-> (Timelock BabbageEra -> Set (KeyHash 'Witness))
-> Maybe (Timelock BabbageEra)
-> Set (KeyHash 'Witness)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set (KeyHash 'Witness)
forall a. Set a
Set.empty Timelock BabbageEra -> Set (KeyHash 'Witness)
forall era.
(AllegraEraScript era, NativeScript era ~ Timelock era) =>
Timelock era -> Set (KeyHash 'Witness)
sufficientTimelock (Script BabbageEra -> Maybe (NativeScript BabbageEra)
forall era. EraScript era => Script era -> Maybe (NativeScript era)
getNativeScript Script era
Script BabbageEra
s)
  Proof era
Conway -> Set (KeyHash 'Witness)
-> (Timelock ConwayEra -> Set (KeyHash 'Witness))
-> Maybe (Timelock ConwayEra)
-> Set (KeyHash 'Witness)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set (KeyHash 'Witness)
forall a. Set a
Set.empty Timelock ConwayEra -> Set (KeyHash 'Witness)
forall era.
(AllegraEraScript era, NativeScript era ~ Timelock era) =>
Timelock era -> Set (KeyHash 'Witness)
sufficientTimelock (Script ConwayEra -> Maybe (NativeScript ConwayEra)
forall era. EraScript era => Script era -> Maybe (NativeScript era)
getNativeScript Script era
Script ConwayEra
s)